Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
asdf
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
18
Issues
18
List
Boards
Labels
Service Desk
Milestones
Merge Requests
12
Merge Requests
12
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
asdf
asdf
Commits
67d8d7df
Commit
67d8d7df
authored
Jan 20, 2013
by
Francois-Rene Rideau
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
2.26.129: adding warnings file support for CCL.
parent
cab5dfa1
Changes
12
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
155 additions
and
52 deletions
+155
-52
action.lisp
action.lisp
+7
-0
asdf.asd
asdf.asd
+1
-1
configuration.lisp
configuration.lisp
+4
-0
header.lisp
header.lisp
+1
-1
lisp-action.lisp
lisp-action.lisp
+13
-10
lisp-build.lisp
lisp-build.lisp
+76
-9
os.lisp
os.lisp
+4
-1
plan.lisp
plan.lisp
+2
-1
test/script-support.lisp
test/script-support.lisp
+8
-1
test/test1.script
test/test1.script
+36
-25
upgrade.lisp
upgrade.lisp
+2
-2
version.lisp-expr
version.lisp-expr
+1
-1
No files found.
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 *file1
*))
(assert (probe-file *file2*
))
(
dolist (f (append *file1.out* *file2.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
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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