diff --git a/asdf.asd b/asdf.asd index 519c54d2dfffbcf1724a8b7be8c043c589c70459..5e3ca5e651893c0ea835299b6ceae12e07244bd4 100644 --- a/asdf.asd +++ b/asdf.asd @@ -75,7 +75,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.1.0.91" ;; to be automatically updated by make bump-version + :version "3.1.0.94" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 :class #.(if (find-class 'package-system nil) 'package-system 'system) diff --git a/bundle.lisp b/bundle.lisp index 4e3106d3eeb7eb93dfbf72c334ed758cfedcfd02..fe020bf359837838014378d84047bc9ff1dcee45 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -240,11 +240,11 @@ itself.")) ;; operation on a system and its dependencies ;; your component-depends-on method better gathered the correct dependencies in the correct order. (while-collecting (collect) (map-direct-dependencies - o c #'(lambda (sub-o sub-c) - (loop :for f :in (funcall key sub-o sub-c) - :when (funcall test f) :do (collect f)))))) + t o c #'(lambda (sub-o sub-c) + (loop :for f :in (funcall key sub-o sub-c) + :when (funcall test f) :do (collect f)))))) - (defmethod input-files ((o bundle-op) (c system)) + (defmethod input-files ((o gather-op) (c system)) (unless (eq (bundle-type o) :no-output-file) (direct-dependency-files o c :test 'bundlable-file-p :key 'output-files))) @@ -368,7 +368,7 @@ itself.")) ;; operation on a system and its dependencies :keep-operation 'load-op)) (while-collecting (x) ;; resolve the sideway-dependencies of s (map-direct-dependencies - 'load-op s + t 'load-op s #'(lambda (o c) (when (and (typep o 'load-op) (typep c 'system)) (x c))))))) @@ -454,8 +454,9 @@ itself.")) ;; operation on a system and its dependencies #+ecl (with-upgradability () - ;; I think that Juanjo intended for this to be, - ;; but it breaks 4 tests in what looks like to be a compiler bug, so I'll punt for now. + ;; I think that Juanjo intended for this to be. + ;; But it might break systems with missing dependencies, + ;; and there is a weird bug in test-xach-update-bug.script ;;(unless (use-ecl-byte-compiler-p) ;; (setf *load-system-operation* 'load-fasl-op)) diff --git a/header.lisp b/header.lisp index c68332348145cc61c8b24416c140db615d536801..8ecca81f68e46a2f5910f5d31aeb4afd729bcdd9 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.1.0.91: Another System Definition Facility. +;;; This is ASDF 3.1.0.94: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/plan.lisp b/plan.lisp index 3531ffbb5b35f892126aa2d083bd6cd33a7e20a5..e79394984072fcb7aa55dcb62282f1bb197c1cb9 100644 --- a/plan.lisp +++ b/plan.lisp @@ -9,7 +9,7 @@ :asdf/operation :asdf/action :asdf/lisp-action) (:export #:component-operation-time #:mark-operation-done - #:plan-traversal #:sequential-plan #:*default-plan-class* + #:plan #:plan-traversal #:sequential-plan #:*default-plan-class* #:planned-action-status #:plan-action-status #:action-already-done-p #:circular-dependency #:circular-dependency-actions #:node-for #:needed-in-image-p @@ -17,7 +17,7 @@ #:plan-record-dependency #:normalize-forced-systems #:action-forced-p #:action-forced-not-p #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies - #:visit-dependencies #:compute-action-stamp #:traverse-action + #:compute-action-stamp #:traverse-action #:circular-dependency #:circular-dependency-actions #:call-while-visiting-action #:while-visiting-action #:make-plan #:plan-actions #:perform-plan #:plan-operates-on-p @@ -32,7 +32,8 @@ ;;;; Generic plan traversal class (with-upgradability () - (defclass plan-traversal () + (defclass plan () ()) + (defclass plan-traversal (plan) ((system :initform nil :initarg :system :accessor plan-system) (forced :initform nil :initarg :force :accessor plan-forced) (forced-not :initform nil :initarg :force-not :accessor plan-forced-not) @@ -146,13 +147,12 @@ the action of OPERATION on COMPONENT in the PLAN")) (with-upgradability () (defgeneric action-valid-p (plan operation component) (:documentation "Is this action valid to include amongst dependencies?")) - (defmethod action-valid-p ((plan plan-traversal) (o operation) (c component)) + (defmethod action-valid-p ((plan t) (o operation) (c component)) (if-let (it (component-if-feature c)) (featurep it) t)) (defmethod action-valid-p ((plan t) (o null) (c t)) nil) (defmethod action-valid-p ((plan t) (o t) (c null)) nil) (defmethod action-valid-p ((plan null) (o operation) (c component)) t)) - ;;;; Is the action needed in this image? (with-upgradability () (defgeneric needed-in-image-p (operation component) @@ -169,38 +169,30 @@ the action of OPERATION on COMPONENT in the PLAN")) ;;;; Visiting dependencies of an action and computing action stamps (with-upgradability () - (defun map-direct-dependencies (operation component fun) + (defun (map-direct-dependencies) (plan operation component fun) (loop* :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component) :for dep-o = (find-operation operation dep-o-spec) :when dep-o :do (loop :for dep-c-spec :in dep-c-specs :for dep-c = (and dep-c-spec (resolve-dependency-spec component dep-c-spec)) - :when dep-c + :when (and dep-c (action-valid-p plan dep-o dep-c)) :do (funcall fun dep-o dep-c)))) - (defun reduce-direct-dependencies (operation component combinator seed) + (defun (reduce-direct-dependencies) (plan operation component combinator seed) (map-direct-dependencies - operation component + plan operation component #'(lambda (dep-o dep-c) (setf seed (funcall combinator dep-o dep-c seed)))) seed) - (defun direct-dependencies (operation component) - (reduce-direct-dependencies operation component #'acons nil)) + (defun (direct-dependencies) (plan operation component) + (reduce-direct-dependencies plan operation component #'acons nil)) ;; In a distant future, get-file-stamp, component-operation-time and latest-stamp ;; shall also be parametrized by the plan, or by a second model object, ;; so they need not refer to the state of the filesystem, ;; and the stamps could be cryptographic checksums rather than timestamps. - ;; Such a change remarkably would only affect VISIT-DEPENDENCIES and COMPUTE-ACTION-STAMP. - - (defun visit-dependencies (plan operation component dependency-stamper &aux stamp) - (map-direct-dependencies - operation component - #'(lambda (dep-o dep-c) - (when (action-valid-p plan dep-o dep-c) - (latest-stamp-f stamp (funcall dependency-stamper dep-o dep-c))))) - stamp) + ;; Such a change remarkably would only affect COMPUTE-ACTION-STAMP. (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done) ;; Given an action, figure out at what time in the past it has been done, @@ -213,52 +205,62 @@ the action of OPERATION on COMPONENT in the PLAN")) ;; Note that if e.g. LOAD-OP only depends on up-to-date files, but ;; hasn't been done in the current image yet, then it can have a non-T timestamp, ;; yet a NIL done-in-image-p flag. - (let* ((stamp-lookup #'(lambda (o c) - (if-let (it (plan-action-status plan o c)) (action-stamp it) t))) - (out-files (output-files o c)) - (in-files (input-files o c)) - ;; Three kinds of actions: - (out-op (and out-files t)) ; those that create files on the filesystem - ;;(image-op (and in-files (null out-files))) ; those that load stuff into the image - ;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing - ;; When was the thing last actually done? (Now, or ask.) - (op-time (or just-done (component-operation-time o c))) - ;; Accumulated timestamp from dependencies (or T if forced or out-of-date) - (dep-stamp (visit-dependencies plan o c stamp-lookup)) - ;; Time stamps from the files at hand, and whether any is missing - (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) - (in-stamps (mapcar #'get-file-stamp in-files)) - (missing-in - (loop :for f :in in-files :for s :in in-stamps :unless s :collect f)) - (missing-out - (loop :for f :in out-files :for s :in out-stamps :unless s :collect f)) - (all-present (not (or missing-in missing-out))) - ;; Has any input changed since we last generated the files? - (earliest-out (stamps-earliest out-stamps)) - (latest-in (stamps-latest (cons dep-stamp in-stamps))) - (up-to-date-p (stamp<= latest-in earliest-out)) - ;; If everything is up to date, the latest of inputs and outputs is our stamp - (done-stamp (stamps-latest (cons latest-in out-stamps)))) - ;; Warn if some files are missing: - ;; either our model is wrong or some other process is messing with our files. - (when (and just-done (not all-present)) - (warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~ - ~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]" - (action-description o c) - missing-in (length missing-in) (and missing-in missing-out) - missing-out (length missing-out))) - ;; Note that we use stamp<= instead of stamp< to play nice with generated files. - ;; Any race condition is intrinsic to the limited timestamp resolution. - (if (or just-done ;; The done-stamp is valid: if we're just done, or - ;; if all filesystem effects are up-to-date and there's no invalidating reason. - (and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan o c)))) - (values done-stamp ;; return the hard-earned timestamp - (or just-done - out-op ;; a file-creating op is done when all files are up to date - ;; a image-effecting a placeholder op is done when it was actually run, - (and op-time (eql op-time done-stamp)))) ;; with the matching stamp - ;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet - (values t nil))))) + (nest + (block ()) + (let ((dep-stamp ; collect timestamp from dependencies (or T if forced or out-of-date) + (reduce-direct-dependencies + plan o c + #'(lambda (o c stamp) + (if-let (it (plan-action-status plan o c)) + (latest-stamp stamp (action-stamp it)) + t)) + nil))) + ;; out-of-date dependency: don't bother expensively querying the filesystem + (when (and (eq dep-stamp t) (not just-done)) (return (values t nil)))) + ;; collect timestamps from inputs, and exit early if any is missing + (let* ((in-files (input-files o c)) + (in-stamps (mapcar #'get-file-stamp in-files)) + (missing-in (loop :for f :in in-files :for s :in in-stamps :unless s :collect f)) + (latest-in (stamps-latest (cons dep-stamp in-stamps)))) + (when (and missing-in (not just-done)) (return (values t nil)))) + ;; collect timestamps from outputs, and exit early if any is missing + (let* ((out-files (output-files o c)) + (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) + (missing-out (loop :for f :in out-files :for s :in out-stamps :unless s :collect f)) + (earliest-out (stamps-earliest out-stamps))) + (when (and missing-out (not just-done)) (return (values t nil)))) + (let* (;; There are three kinds of actions: + (out-op (and out-files t)) ; those that create files on the filesystem + ;;(image-op (and in-files (null out-files))) ; those that load stuff into the image + ;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing + ;; When was the thing last actually done? (Now, or ask.) + (op-time (or just-done (component-operation-time o c))) + ;; Time stamps from the files at hand, and whether any is missing + (all-present (not (or missing-in missing-out))) + ;; Has any input changed since we last generated the files? + (up-to-date-p (stamp<= latest-in earliest-out)) + ;; If everything is up to date, the latest of inputs and outputs is our stamp + (done-stamp (stamps-latest (cons latest-in out-stamps)))) + ;; Warn if some files are missing: + ;; either our model is wrong or some other process is messing with our files. + (when (and just-done (not all-present)) + (warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~ + ~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]" + (action-description o c) + missing-in (length missing-in) (and missing-in missing-out) + missing-out (length missing-out)))) + ;; Note that we use stamp<= instead of stamp< to play nice with generated files. + ;; Any race condition is intrinsic to the limited timestamp resolution. + (if (or just-done ;; The done-stamp is valid: if we're just done, or + ;; if all filesystem effects are up-to-date and there's no invalidating reason. + (and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan o c)))) + (values done-stamp ;; return the hard-earned timestamp + (or just-done + out-op ;; a file-creating op is done when all files are up to date + ;; a image-effecting a placeholder op is done when it was actually run, + (and op-time (eql op-time done-stamp)))) ;; with the matching stamp + ;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet + (values t nil))))) ;;;; Generic support for plan-traversal @@ -345,8 +347,8 @@ the action of OPERATION on COMPONENT in the PLAN")) (when (and status (or (action-done-p status) (action-planned-p status) (not eniip))) (return (action-stamp status))) ; Already visited with sufficient need-in-image level! (labels ((visit-action (niip) ; We may visit the action twice, once with niip NIL, then T - (visit-dependencies plan operation component ; recursively traverse dependencies - #'(lambda (o c) (traverse-action plan o c niip))) + (map-direct-dependencies ; recursively traverse dependencies + plan operation component #'(lambda (o c) (traverse-action plan o c niip))) (multiple-value-bind (stamp done-p) ; AFTER dependencies have been traversed, (compute-action-stamp plan operation component) ; compute action stamp (let ((add-to-plan-p (or (eql stamp t) (and niip (not done-p))))) @@ -391,7 +393,7 @@ the action of OPERATION on COMPONENT in the PLAN")) (when (action-planned-p new-status) (push (cons o c) (plan-actions-r p))))) -;;;; high-level interface: traverse, perform-plan, plan-operates-on-p +;;;; High-level interface: traverse, perform-plan, plan-operates-on-p (with-upgradability () (defgeneric make-plan (plan-class operation component &key &allow-other-keys) (:documentation @@ -404,8 +406,7 @@ the action of OPERATION on COMPONENT in the PLAN")) (defvar *default-plan-class* 'sequential-plan) (defmethod make-plan (plan-class (o operation) (c component) &rest keys &key &allow-other-keys) - (let ((plan (apply 'make-instance - (or plan-class *default-plan-class*) + (let ((plan (apply 'make-instance (or plan-class *default-plan-class*) :system (component-system c) keys))) (traverse-action plan o c t) plan)) @@ -464,8 +465,9 @@ the action of OPERATION on COMPONENT in the PLAN")) plan)) (define-convenience-action-methods traverse-sub-actions (operation component &key)) - (defmethod traverse-sub-actions ((operation operation) (component component) &rest keys &key &allow-other-keys) - (apply 'traverse-actions (direct-dependencies operation component) + (defmethod traverse-sub-actions ((operation operation) (component component) + &rest keys &key &allow-other-keys) + (apply 'traverse-actions (direct-dependencies t operation component) :system (component-system component) keys)) (defmethod plan-actions ((plan filtered-sequential-plan)) diff --git a/test/test-asdf.asd b/test/test-asdf.asd index 331e2edf2114fa1e6f8441b6d6ba4372aea3ad35..027002bae49a97eeb485252df0a8b943449fceb4 100644 --- a/test/test-asdf.asd +++ b/test/test-asdf.asd @@ -66,7 +66,9 @@ :components ((:file "file1") (:file "file3"))) (defsystem :test-asdf/bundle-2 - :depends-on (:test-asdf/bundle-1) :components ((:file "file2"))) + :depends-on (:test-asdf/bundle-1) :components + ((:file "file2") + (:file "invalid-file" :if-feature (:not :common-lisp)))) (defsystem :test-asdf/force :depends-on (:test-asdf/force1) diff --git a/test/test-inline-methods.script b/test/test-inline-methods.script index 42e2003b403094fa97af328133aa8d612cdf0f76..b1eaaabd318fcfd03f542642cc65c32eed903a10 100644 --- a/test/test-inline-methods.script +++ b/test/test-inline-methods.script @@ -7,13 +7,15 @@ ((:file "file1" :perform (load-op :before (o c) (incf *a*) - (format t "Method run before ~A~%" (action-description o c)))) + (format t "Method run before ~A - *a* = ~S~%~%" (action-description o c) *a*))) (:file "file2" :depends-on ("file1") :perform (load-op (o c) (incf *a*) - (format t "Method run for ~A~%" (action-description o c)) + (format t "Method run for ~A - *a* = ~S~%" (action-description o c) *a*) (call-next-method))))) -(load-system :foo) +;;; Note: not calling load-system, because on ECL that would be a load-fasl-op, +;;; and at most the file load-op happen, whereas the second .o is linked and never loaded. +(operate 'load-op :foo) (assert-equal *a* 2) diff --git a/test/test-system-pathnames.script b/test/test-system-pathnames.script index dfd650fb18ba0ae9a4080c88aa8570272fb96c02..dd36484f2941e5a5c001f0bf1dd7cb0dbb7fd1fc 100644 --- a/test/test-system-pathnames.script +++ b/test/test-system-pathnames.script @@ -5,7 +5,7 @@ :source-file nil :components ((:file "file1") - (:file "file2" :pathname "level2/file2") + (:file "file2" :pathname "level2/file2" :depends-on ("file1")) (:static-file "level2/static.file") (:static-file "test-tmp.cl"))) diff --git a/test/test-xach-update-bug.script b/test/test-xach-update-bug.script index 74fdc5ed2cdb13d1c1f2bcc1bd5b40c5fcc03b2e..76974b6b95e0a13ae397152783f2ae9ed61837d1 100644 --- a/test/test-xach-update-bug.script +++ b/test/test-xach-update-bug.script @@ -40,6 +40,11 @@ (subpathname *test-directory* "xach-foo-2/b.lisp") (component-pathname (find-component foo2 "b"))) (DBG "load foo yet again. It should see the pathname has changed and load it anew") -(load-system foo) +;;; ECL bug: this fails if we use load-fasl-op instead of load-op: +;;; the test-asdf-location-change.fasb is linked and loaded, +;;; but that fails to create the :second-version package; +;;; loading the same .fasb in another ecl works fine, and defined (second-version:wtf). WTF? +;;; Test it by replacing load-op below by load-fasl-op, and trace load* and other functions. +(operate 'load-op foo) (assert (symbol-value (find-symbol* :loaded :second-version))) (assert-equal 42 (symbol-call :second-version :wtf)) diff --git a/test/test2.script b/test/test2.script index 24d66277cb9eafdc825254c0a7b95123f498a9e0..d92eb5bfb550f4d4cd90c44e3e4b9570f2409ad9 100644 --- a/test/test2.script +++ b/test/test2.script @@ -1,9 +1,10 @@ ;;; -*- Lisp -*- - +;; We don't use load-system, because it can be load-fasl-op on ECL, +;; and these systems define manual dependencies on compile-op. (DBG "test2: loading test2b1") -(asdf:load-system 'test2b1) +(operate 'load-op 'test2b1) (DBG "test2: file3 and file4 were compiled") (assert (and (probe-file (test-fasl "file3.lisp")) @@ -12,7 +13,7 @@ (DBG "test2: loading test2b2 should fail") (handler-case - (asdf:load-system 'test2b2) + (operate 'load-op 'test2b2) (asdf:missing-dependency (c) (format t "load failed as expected: - ~%~A~%" c)) (:no-error (c) @@ -22,7 +23,7 @@ (DBG "test2: loading test2b3 should fail") (handler-case - (asdf:load-system 'test2b3) + (operate 'load-op 'test2b3) (asdf:missing-dependency (c) (format t "load failed as expected: - ~%~A~%" c)) (:no-error (c) diff --git a/test/xach-foo-2/a.lisp b/test/xach-foo-2/a.lisp index d8dee0d71588e79bd3d0975e6248341547b5f213..ea2b5ac2041698d642384eb9a0a01fc7e2b38342 100644 --- a/test/xach-foo-2/a.lisp +++ b/test/xach-foo-2/a.lisp @@ -7,6 +7,3 @@ (in-package :second-version) (defparameter loaded t) - - - diff --git a/test/xach-foo-2/test-asdf-location-change.asd b/test/xach-foo-2/test-asdf-location-change.asd index 1471f4c58ad17ac979fb9890af37626faff6237f..e1290b8cd154c4700660c9fd539650b12e82aab5 100644 --- a/test/xach-foo-2/test-asdf-location-change.asd +++ b/test/xach-foo-2/test-asdf-location-change.asd @@ -3,4 +3,4 @@ (asdf:defsystem #:test-asdf-location-change :serial t :components ((:file "a") - (:file "b"))) + (:file "b" :depends-on ("a")))) diff --git a/upgrade.lisp b/upgrade.lisp index 3a2d568ab6566e87c76361e3363a9dbb02823752..47231fc5d6ef2cfb99086d0d95bed371a7ba5c46 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -68,7 +68,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.1.0.91") + (asdf-version "3.1.0.94") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -89,6 +89,7 @@ previously-loaded version of ASDF." #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action #:component-depends-on #:operation-done-p #:component-depends-on #:traverse ;; backward-interface + #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan #:operate ;; operate #:parse-component-form ;; defsystem #:apply-output-translations ;; output-translations diff --git a/version.lisp-expr b/version.lisp-expr index 8b765ed1b08d7e77d5be2739d7f0b84a212b67d0..e39bd9898be5c7cdf82960803fe265836e766798 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,2 @@ -"3.1.0.91" +"3.1.0.94"