Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
67d8d7df
Commit
67d8d7df
authored
Jan 20, 2013
by
Francois-Rene Rideau
Browse files
2.26.129: adding warnings file support for CCL.
parent
cab5dfa1
Changes
12
Hide whitespace changes
Inline
Side-by-side
action.lisp
View file @
67d8d7df
...
...
@@ -18,6 +18,7 @@
#:component-operation-time
#:mark-operation-done
#:compute-action-stamp
#:perform
#:perform-with-restarts
#:retry
#:accept
#:feature
#:traverse-actions
#:traverse-sub-actions
#:required-components
;; in plan
#:action-path
#:find-action
))
(
in-package
:asdf/action
)
...
...
@@ -27,6 +28,12 @@
(
defgeneric*
traverse-sub-actions
(
operation
component
&key
&allow-other-keys
))
(
defgeneric*
required-components
(
component
&key
&allow-other-keys
))
;;;; Reified representation for storage or debugging. Note: dropping original-initags
(
defun
action-path
(
action
)
(
destructuring-bind
(
o
.
c
)
action
(
cons
(
type-of
o
)
(
component-find-path
c
))))
(
defun
find-action
(
path
)
(
destructuring-bind
(
o
.
c
)
path
(
cons
(
make-operation
o
)
(
find-component
()
c
))))
;;;; Convenience methods
(
defmacro
define-convenience-action-methods
...
...
asdf.asd
View file @
67d8d7df
...
...
@@ -15,7 +15,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.26.12
8
"
;; to be automatically updated by make bump-version
:version
"2.26.12
9
"
;; to be automatically updated by make bump-version
:depends-on
()
:components
((
:module
"build"
:components
((
:file
"asdf"
))))
:in-order-to
(
#+
asdf2.27
(
compile-op
(
monolithic-load-concatenated-source-op
asdf/defsystem
))))
...
...
configuration.lisp
View file @
67d8d7df
...
...
@@ -235,6 +235,10 @@ directive.")
:wilden
(
and
wilden
(
not
(
pathnamep
x
)))
:want-absolute
t
))
;; Try to override declaration in previous versions of ASDF.
(
declaim
(
ftype
(
function
(
t
&key
(
:directory
boolean
)
(
:wilden
boolean
)
(
:ensure-directory
boolean
))
t
)
resolve-location
))
(
defun*
(
resolve-location
)
(
x
&key
ensure-directory
wilden
directory
)
(
when
directory
(
setf
ensure-directory
t
))
;; :directory backward compatibility, until 2014-01-16.
(
if
(
atom
x
)
...
...
header.lisp
View file @
67d8d7df
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.12
8
: Another System Definition Facility.
;;; This is ASDF 2.26.12
9
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
lisp-action.lisp
View file @
67d8d7df
...
...
@@ -81,7 +81,7 @@
(
outputs
(
output-files
o
c
)))
(
multiple-value-bind
(
output
warnings-p
failure-p
)
(
destructuring-bind
(
output-file
&optional
#+
(
or
ecl
mkcl
)
object-file
#+
sbcl
warnings-file
)
outputs
(
output-file
&optional
#+
(
or
ecl
mkcl
)
object-file
#+
(
or
clozure
sbcl
)
warnings-file
)
outputs
(
call-with-around-compile-hook
c
#'
(
lambda
(
&rest
flags
)
(
with-muffled-compiler-conditions
()
...
...
@@ -90,7 +90,7 @@
:external-format
(
component-external-format
c
)
(
append
#+
(
or
ecl
mkcl
)
(
list
:object-file
object-file
)
#+
sbcl
(
list
:warnings-file
warnings-file
)
#+
(
or
clozure
sbcl
)
(
list
:warnings-file
warnings-file
)
flags
(
compile-op-flags
o
)))))))
(
check-lisp-compile-results
output
warnings-p
failure-p
"~/asdf-action::format-action/"
(
list
(
cons
o
c
))))))
...
...
@@ -114,12 +114,15 @@
(
f
(
compile-file-pathname
i
#+
mkcl
:fasl-p
#+
mkcl
t
#+
ecl
:type
#+
ecl
:fasl
)))
`
(
,
f
;; the fasl is the primary output, in first position
#+
ecl
,@
(
unless
(
use-ecl-byte-compiler-p
)
`
(
,
(
compile-file-pathname
i
:type
:object
)))
#+
mkcl
,
(
compile-file-pathname
i
:fasl-p
nil
)
;; object file
#+
sbcl
,@
(
let
((
s
(
component-system
c
)))
(
unless
(
builtin-system-p
s
)
; includes ASDF itself
`
(
,
(
make-pathname
:type
"sbcl-warnings"
:defaults
f
)))))))
#+
(
or
clozure
sbcl
)
,@
(
let
((
s
(
component-system
c
)))
(
unless
(
builtin-system-p
s
)
; includes ASDF itself
`
(
,
(
make-pathname
:type
(
warnings-file-type
)
:defaults
f
))))
#+
ecl
,@
(
unless
(
use-ecl-byte-compiler-p
)
`
(
,
(
compile-file-pathname
i
:type
:object
)))
#+
mkcl
,
(
compile-file-pathname
i
:fasl-p
nil
))))
;; object file
(
defmethod
component-depends-on
((
o
compile-op
)
(
c
component
))
(
declare
(
ignorable
o
))
`
((
prepare-op
,
c
)
,@
(
call-next-method
)))
...
...
@@ -133,7 +136,7 @@
(
declare
(
ignorable
o
c
))
nil
#+
sbcl
(
perform-lisp-warnings-check
o
c
))
#+
sbcl
#+
(
or
clozure
sbcl
)
(
defmethod
input-files
((
o
compile-op
)
(
c
system
))
(
declare
(
ignorable
o
c
))
(
unless
(
builtin-system-p
c
)
...
...
@@ -142,7 +145,7 @@
o
c
:other-systems
nil
:keep-operation
'compile-op
:keep-component
'cl-source-file
)
:append
(
remove-if-not
'warnings-file-p
(
output-files
sub-o
sub-c
)))))
(
output-files
sub-o
sub-c
)))))
#+
sbcl
(
defmethod
output-files
((
o
compile-op
)
(
c
system
))
(
unless
(
builtin-system-p
c
)
...
...
lisp-build.lisp
View file @
67d8d7df
...
...
@@ -22,7 +22,7 @@
#:reify-simple-sexp
#:unreify-simple-sexp
#:reify-deferred-warnings
#:reify-undefined-warning
#:unreify-deferred-warnings
#:reset-deferred-warnings
#:save-deferred-warnings
#:check-deferred-warnings
#:with-saved-deferred-warnings
#:warnings-file-p
#:with-saved-deferred-warnings
#:warnings-file-p
#:warnings-file-type
#:call-with-asdf-compilation-unit
#:with-asdf-compilation-unit
#:current-lisp-file-pathname
#:load-pathname
#:lispize-pathname
#:compile-file-type
#:call-around-hook
...
...
@@ -193,11 +193,41 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(
cons
(
cons
(
unreify-simple-sexp
(
car
sexp
))
(
unreify-simple-sexp
(
cdr
sexp
))))
((
simple-vector
2
)
(
unreify-symbol
sexp
))))
#+
clozure
(
progn
(
defun
reify-source-note
(
source-note
)
(
when
source-note
(
with-accessors
((
source
ccl::source-note-source
)
(
filename
ccl:source-note-filename
)
(
start-pos
ccl:source-note-start-pos
)
(
end-pos
ccl:source-note-end-pos
))
source-note
(
declare
(
ignorable
source
))
(
list
:filename
filename
:start-pos
start-pos
:end-pos
end-pos
#|:source (reify-source-note source)|#
))))
(
defun
unreify-source-note
(
source-note
)
(
when
source-note
(
destructuring-bind
(
&key
filename
start-pos
end-pos
source
)
source-note
(
ccl::make-source-note
:filename
filename
:start-pos
start-pos
:end-pos
end-pos
:source
(
unreify-source-note
source
)))))
(
defun
reify-deferred-warning
(
deferred-warning
)
(
with-accessors
((
warning-type
ccl::compiler-warning-warning-type
)
(
args
ccl::compiler-warning-args
)
(
source-note
ccl:compiler-warning-source-note
)
(
function-name
ccl:compiler-warning-function-name
))
deferred-warning
(
list
:warning-type
warning-type
:function-name
(
reify-simple-sexp
function-name
)
:source
(
reify-source-note
source-note
)
:args
(
reify-simple-sexp
args
))))
(
defun
unreify-deferred-warning
(
reified-deferred-warning
)
(
destructuring-bind
(
&key
warning-type
function-name
source-note
args
)
reified-deferred-warning
(
make-condition
(
or
(
cdr
(
ccl::assq
warning-type
ccl::*compiler-whining-conditions*
))
'ccl::compiler-warning
)
:function-name
(
unreify-simple-sexp
function-name
)
:source-note
(
unreify-source-note
source-note
)
:warning-type
warning-type
:args
(
unreify-simple-sexp
args
)))))
#+
sbcl
(
defun
reify-undefined-warning
(
warning
)
;; Extracting undefined-warnings from the compilation-unit
;; To be passed through the above reify/unreify link, it must be a "simple-sexp"
#-
sbcl
(
declare
(
ignore
warning
))
#+
sbcl
(
list*
(
sb-c::undefined-warning-kind
warning
)
(
sb-c::undefined-warning-name
warning
)
...
...
@@ -215,7 +245,10 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(
sb-c::undefined-warning-warnings
warning
))))
(
defun
reify-deferred-warnings
()
#-
sbcl
nil
#+
clozure
(
mapcar
'reify-deferred-warning
(
if-let
(
dw
ccl::*outstanding-deferred-warnings*
)
(
ccl::deferred-warnings.warnings
dw
)))
#+
sbcl
(
when
sb-c::*in-compilation-unit*
;; Try to send nothing through the pipe if nothing needs to be accumulated
...
...
@@ -231,10 +264,15 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
:when
(
plusp
value
)
:collect
`
(
,
what
.
,
value
)))))
(
defun
unreify-deferred-warnings
(
constructor-list
)
#-
sbcl
(
declare
(
ignore
constructor-list
))
(
defun
unreify-deferred-warnings
(
reified-deferred-warnings
)
(
declare
(
ignorable
reified-deferred-warnings
))
#+
clozure
(
let
((
dw
(
or
ccl::*outstanding-deferred-warnings*
(
setf
ccl::*outstanding-deferred-warnings*
(
ccl::%defer-warnings
t
)))))
(
setf
(
ccl::deferred-warnings.warnings
dw
)
(
mapcar
'unreify-deferred-warning
reified-deferred-warnings
)))
#+
sbcl
(
dolist
(
item
constructor-list
)
(
dolist
(
item
reified-deferred-warnings
)
;; Each item is (symbol . adjustment) where the adjustment depends on the symbol.
;; For *undefined-warnings*, the adjustment is a list of initargs.
;; For everything else, it's an integer.
...
...
@@ -261,6 +299,9 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(
set
symbol
(
+
(
symbol-value
symbol
)
adjustment
)))))))
(
defun
reset-deferred-warnings
()
#+
clozure
(
if-let
((
dw
ccl::*outstanding-deferred-warnings*
))
(
setf
(
ccl::deferred-warnings.warnings
dw
)
nil
))
#+
sbcl
(
when
sb-c::*in-compilation-unit*
(
setf
sb-c::*undefined-warnings*
nil
...
...
@@ -279,8 +320,14 @@ possibly in a different process."
(
terpri
s
)))
(
reset-deferred-warnings
))
(
defun*
warnings-file-p
(
file
)
(
equal
(
pathname-type
file
)
"sbcl-warnings"
))
(
defun*
warnings-file-type
(
&optional
implementation-type
)
(
case
(
or
implementation-type
*implementation-type*
)
(
:sbcl
"sbcl-warnings"
)
((
:clozure
:ccl
)
"ccl-warnings"
)))
(
defun*
warnings-file-p
(
file
&optional
implementation-type
)
(
if-let
(
type
(
warnings-file-type
implementation-type
))
(
equal
(
pathname-type
file
)
type
)))
(
defun*
check-deferred-warnings
(
files
&optional
context-format
context-arguments
)
(
let
((
file-errors
nil
)
...
...
@@ -306,6 +353,26 @@ possibly in a different process."
;;;; Deferred warnings
#|
Mini-guide to adding support for deferred warnings on an implementation.
First, look at what such a warning looks like:
(describe
(handler-case
(and (eval '(lambda () (some-undefined-function))) nil)
(t (c) c)))
Then you can grep for the condition type in your compiler sources
and see how to catch those that have been deferred,
and/or read, clear and restore the deferred list.
ccl::
undefined-function-reference
verify-deferred-warning
report-deferred-warnings
|#
(
defun*
call-with-saved-deferred-warnings
(
thunk
warnings-file
)
(
if
warnings-file
...
...
os.lisp
View file @
67d8d7df
...
...
@@ -12,7 +12,8 @@
#:getenv-pathname
#:getenv-pathnames
#:getenv-absolute-directory
#:getenv-absolute-directories
#:implementation-identifier
;; implementation identifier
#:implementation-type
#:operating-system
#:architecture
#:lisp-version-string
#:implementation-type
#:*implementation-type*
#:operating-system
#:architecture
#:lisp-version-string
#:hostname
#:user-homedir
#:lisp-implementation-directory
#:getcwd
#:chdir
#:call-with-current-directory
#:with-current-directory
#:*temporary-directory*
#:temporary-directory
#:default-temporary-directory
...
...
@@ -161,6 +162,8 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
(
:lwpe
:lispworks-personal-edition
)
(
:lw
:lispworks
)
:mcl
:mkcl
:sbcl
:scl
(
:smbx
:symbolics
)
:xcl
)))
(
defvar
*implementation-type*
(
implementation-type
))
(
defun*
operating-system
()
(
first-feature
'
(
:cygwin
(
:win
:windows
:mswindows
:win32
:mingw32
)
;; try cygwin first!
...
...
plan.lisp
View file @
67d8d7df
...
...
@@ -196,6 +196,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
(
latest-stamp-f
stamp
(
funcall
dependency-stamper
dep-o
dep-c
)))))
stamp
)
(
asdf-debug
)
(
defmethod
compute-action-stamp
(
plan
(
o
operation
)
(
c
component
)
&key
just-done
)
;; In a distant future, safe-file-write-date and component-operation-time
;; shall also be parametrized by the plan, or by a second model object.
...
...
@@ -246,7 +248,6 @@ the action of OPERATION on COMPONENT in the PLAN"))
;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet
(
values
t
nil
))))
;;;; Generic support for plan-traversal
(
defgeneric*
plan-record-dependency
(
plan
operation
component
))
...
...
test/script-support.lisp
View file @
67d8d7df
...
...
@@ -23,6 +23,7 @@ Some constraints:
#:assert-compare
#:assert-equal
#:leave-test
#:def-test-system
#:action-name
#:in-plan-p
#:test-source
#:test-fasl
#:resolve-output
#:output-location
#:quietly
))
...
...
@@ -438,6 +439,9 @@ is bound, write a message and exit on an error. If
`
(
apply
(
asym
:register-system-definition
)
',name
:pathname
,
*test-directory*
:source-file
nil
',rest
))
(
defun
in-plan-p
(
plan
x
)
(
member
x
plan
:key
(
asym
:action-path
)
:test
'equal
))
;; These are shorthands for interactive debugging of test scripts:
(
!a
common-lisp-user::debug-asdf
debug-asdf
...
...
@@ -451,4 +455,7 @@ is bound, write a message and exit on an error. If
It depends on the DBG macro in contrib/debug.lisp,
that you should load in your asdf/plan by inserting an (asdf-debug) form in it.
#+DBG-ASDF (DBG :cas o c just-done plan stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c))|#
(let ((action-path (action-path (cons o c)))) (DBG :cas action-path just-done plan stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c)
;;; blah
))
|#
test/test1.script
View file @
67d8d7df
...
...
@@ -2,46 +2,57 @@
(load-asdf)
(touch-file "test1.asd" :offset -3600) ;; touch test1.asd an hour ago.
(touch-file "file1.lisp" :offset -3500)
(touch-file "file2.lisp" :offset -3400)
(touch-file (test-source "test1.asd") :offset -3600) ;; touch test1.asd an hour ago.
(defparameter *date* (file-write-date (test-source "test1.asd")))
(touch-file (test-source "file1.lisp") :timestamp (+ *date* 100))
(touch-file (test-source "file2.lisp") :timestamp (+ *date* 200))
(assert-equal (file-write-date (test-source "file1.lisp")) (+ *date* 100))
(assert-equal (file-write-date (test-source "file2.lisp")) (+ *date* 200))
(DBG "loading test1")
(
asdf:
load-system 'test1)
(load-system 'test1)
(defparameter *file1
* (test-fasl
"file1"))
(defparameter *file2
* (test-fasl
"file2"))
(
defparameter *date* (file-write-date "test1.asd
"))
(
defparameter *then* (file-write-date *
file2
*
))
(defparameter *file1
.out* (output-files 'compile-op '(test1
"file1"))
)
(defparameter *file2
.out* (output-files 'compile-op '(test1
"file2"))
)
(
assert-equal (first *file1.out*) (test-fasl "file1
"))
(
assert-equal (first *file2.out*) (test-fasl "
file2
"
))
(assert-equal *file1* (first (output-files 'compile-op '("test1" "file1"))))
(assert-equal *date* (file-write-date (test-source "test1.asd")))
(defparameter *then* (file-write-date (first *file2.out*)))
(assert-compare (< *date* *then*))
(DBG "test that it compiled" *date* *then*)
(
assert (probe-file
*file
1
*))
(assert (probe-file
*file2*
))
(
dolist (f (append *file1.out*
*file
2.out
*))
(eval `
(assert (probe-file
,f))
))
(DBG "and loaded")
(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
(DBG "now remove file2 that depends-on file1" *date*)
(touch-file *file1* :timestamp (+ *date* 500))
(assert-equal (+ *date* 500) (file-write-date *file1*))
(asdf::delete-file-if-exists *file2*)
(DBG "now remove file2 that depends-on file1")
(dolist (f *file1.out*) (touch-file f :timestamp (+ *date* 500)))
(assert-equal (+ *date* 500) (file-write-date (first *file1.out*)))
(map () 'delete-file-if-exists *file2.out*)
(clear-system 'test1)
(DBG "load again")
(asdf:clear-system 'test1)
(asdf:load-system 'test1)
(DBG "check that file1 is _not_ recompiled, but file2 is" (file-write-date *file1*))
(assert-equal (+ *date* 500) (file-write-date *file1*))
(assert-compare (<= *then* (file-write-date *file2*)))
;;(trace input-files asdf::compute-action-stamp)
(defparameter *plan* (nth-value 1 (operate 'load-op 'test1)))
(DBG "check that file1 is _not_ recompiled, but file2 is")
(assert (in-plan-p *plan* '(compile-op "test1" "file2")))
(assert (not (in-plan-p *plan* '(compile-op "test1" "file1"))))
(assert-equal (+ *date* 500) (file-write-date (first *file1.out*)))
(assert-compare (<= *then* (file-write-date (first *file2.out*))))
(DBG "now touch file1 and check that file2 _is_ also recompiled")
;; XXX run-shell-command loses if *default-pathname-defaults* is not the
;; unix cwd. this is not a problem for run-tests.sh, but can be in general
(defparameter *before* (file-write-date
*file2*
))
(touch-file "file1.lisp" :timestamp (+ *date* 3000)) ;; touch file1 a minute ago.
(touch-file
*file2*
:timestamp (+ *date* 2000)) ;; touch file2.fasl some time before.
(defparameter *before* (file-write-date
(first *file2.out*)
))
(touch-file
(test-source
"file1.lisp"
)
:timestamp (+ *date* 3000)) ;; touch file1 a minute ago.
(dolist (f *file2.out*)
(touch-file
f
:timestamp (+ *date* 2000))
)
;; touch file2.fasl some time before.
(asdf:clear-system 'test1)
(asdf:operate 'asdf:load-op 'test1)
(DBG :foo (file-write-date *file2*) *before*)
(assert-compare (>= (file-write-date *file2*) *before*))
(DBG :foo (file-write-date (first *file2.out*)) *before*)
(assert-compare (>= (file-write-date (first *file2.out*)) *before*))
upgrade.lisp
View file @
67d8d7df
...
...
@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(
asdf-version
"2.26.12
8
"
)
(
asdf-version
"2.26.12
9
"
)
(
existing-asdf
(
find-class
(
find-symbol*
:component
:asdf
nil
)
nil
))
(
existing-version
*asdf-version*
)
(
already-there
(
equal
asdf-version
existing-version
))
...
...
@@ -46,7 +46,7 @@
#:perform-with-restarts
#:component-relative-pathname
#:system-source-file
#:operate
#:find-component
#:find-system
#:apply-output-translations
#:component-self-dependencies
#:system-relative-pathname
#:system-relative-pathname
#:resolve-location
#:inherit-source-registry
#:process-source-registry
#:process-source-registry-directive
#:source-file-type
#:process-output-translations-directive
...
...
version.lisp-expr
View file @
67d8d7df
"2.26.12
8
"
"2.26.12
9
"
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment