diff --git a/asdf.asd b/asdf.asd index 60d994634c1a0c50129069413d8bc676c7740aa8..64417241ad991a3fce32fb4f0badcd83c94ecee6 100644 --- a/asdf.asd +++ b/asdf.asd @@ -14,7 +14,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.45" ;; to be automatically updated by bin/bump-revision + :version "2.26.46" ;; to be automatically updated by bin/bump-revision :depends-on () :components ((:file "asdf"))) diff --git a/asdf.lisp b/asdf.lisp index 85522aaf58665a7741b4d6ad9b08dfdf589534e0..96c804a1f181eeca3483aa46383be17e301ed3b9 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -1,5 +1,5 @@ ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.26.45: Another System Definition Facility. +;;; This is ASDF 2.26.46: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. @@ -118,7 +118,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.45") + (asdf-version "2.26.46") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -1154,22 +1154,12 @@ the head of the tree")) (defgeneric* component-visited-p (operation component) ;; ASDF3: rename to action-visited-p (:documentation "Returns the data stored by a call to MARK-COMPONENT-VISITED, if that has been called, otherwise NIL. -This data value will be a CONS cell, the CAR of which is a STAMP -of the status of the action, which is T if it has to be performed again; -the CDR will be a count of nodes visited before this one, useful for sorting.")) - -(defgeneric* mark-component-visited (operation component data) - (:documentation "Record DATA as being associated with OPERATION -and COMPONENT. This is a side-effecting function: the association -will be recorded on the ROOT OPERATION \(OPERATION-ANCESTOR of the -OPERATION\). - No evidence that DATA is ever interesting, beyond just being -non-NIL. Using the data field is probably very risky; if there is -already a record for OPERATION X COMPONENT, DATA will be quietly -discarded instead of recorded. - Starting with 2.006, TRAVERSE will store an integer in data, -so that nodes can be sorted in decreasing order of traversal.")) +This data value will be an ACTION-STATUS object.")) +(defgeneric* mark-component-visited (operation component action-status) + (:documentation "Record ACTION-STATUS as being associated with OPERATION and COMPONENT. +This is a side-effecting function: the association will be recorded on +the ROOT OPERATION (OPERATION-ANCESTOR of the OPERATION).")) (defgeneric* (setf visiting-component) (new-value operation component)) @@ -2253,6 +2243,14 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (latest-stamp-f stamp (funcall fun dep-o dep-c)))) stamp) +(defgeneric needed-in-image-p (operation component) + (:method ((o operation) (c component)) + ;; We presume that actions that modify the filesystem don't need be run + ;; in the current image if they have already been done in another, + ;; and can be run in another process (e.g. a fork), + ;; whereas those that don't are meant to side-effect the current image and can't. + (not (output-files o c)))) + (defvar *visit-count* 0) ; counter that allows to sort nodes from operation-visited-nodes (defun* visit-action (o c plan recurse fun) @@ -2263,7 +2261,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (visit-dependencies o c recurse) (multiple-value-bind (stamp done-p) (compute-action-stamp o c :plan plan) - (funcall fun o c done-p stamp)))) + (funcall fun done-p stamp)))) (defmethod mark-component-visited ((o operation) (c component) data) (unless (nth-value 1 (component-visited-p o c)) @@ -2282,13 +2280,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (declare (ignorable plan)) (nth-value 1 (component-operation-time o c))) -(defmethod action-visited-stamp ((plan (eql 'traverse)) (o operation) (c component)) - (declare (ignorable plan)) - (car (component-visited-p o c))) -(defmethod action-already-done-p ((plan (eql 'traverse)) (o operation) (c component)) - (declare (ignorable plan)) - (second (component-visited-p o c))) - (defmethod mark-operation-done ((o operation) (c component)) (setf (gethash (type-of o) (component-operation-times c)) (compute-action-stamp o c :just-done t))) @@ -2361,27 +2352,83 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (defmacro with-component-being-visited ((o c) &body body) `(call-with-component-being-visited ,o ,c #'(lambda () ,@body))) -(defgeneric* traverse-action (operation component collect)) - -(defmethod traverse-action ((o operation) (c component) collect) - ;; Have we been visited yet? If so, just process the result. - (multiple-value-bind (s p) (component-visited-p o c) - (if p (car s) - (with-component-being-visited (o c) - (funcall 'visit-action - o c 'traverse - #'(lambda (o c) (traverse-action o c collect)) - #'(lambda (o c done-p stamp) - (mark-component-visited o c (cons stamp (unless done-p (incf *visit-count*)))) - (if done-p - (mark-operation-done o c) - (funcall collect (cons o c))) - stamp)))))) +(defclass action-status () + ((stamp + :initarg :stamp :reader action-stamp + :documentation "STAMP associated with the ACTION if it has been completed already +in some previous image, or T if it needs to be done.") + (planned-p + :initarg :planned-p :reader action-planned-p + :documentation "generalized boolean, true iff the action was included in the plan. +If true, an integer indexing the action in the list of actions planned, +or T if already done.")) + (:documentation + "Status of an action in a plan")) + +(defmethod action-visited-stamp ((plan (eql 'traverse)) (o operation) (c component)) + (declare (ignorable plan)) + (aif (component-visited-p o c) (action-stamp it))) + +(defmethod action-already-done-p ((plan (eql 'traverse)) (o operation) (c component)) + (declare (ignorable plan)) + (aif (component-visited-p o c) (action-planned-p it))) + +(defgeneric* traverse-action (operation component needed-in-image-p collect)) + +(defmethod traverse-action ((o operation) (c component) needed-in-image-p collect) + (let ((niip (and needed-in-image-p (needed-in-image-p o c))) + (status (component-visited-p o c))) + (if (and status (or (action-planned-p status) (not niip))) + ;; Already visited with sufficient level of need-in-image: just return the stamp. + (action-stamp status) + (labels ((recurse (niip) + #'(lambda (o c) (traverse-action o c niip collect))) + (revisit-harder () + ;; but it was first visited without + (visit-action + o c 'traverse (recurse t) + #'(lambda (done-p stamp) + (assert (not done-p)) + (mark-component-visited + o c (make-instance 'action-status + :stamp stamp + :planned-p (incf *visit-count*))) + (funcall collect (cons o c)) + stamp)))) + (with-component-being-visited (o c) + (cond + (status + ;; Already visited, it had all its input up-to-date, + ;; wasn't previously need in image but now is. + (revisit-harder)) + (t + ;; Not visited yet. + (visit-action + o c 'traverse (recurse niip) + #'(lambda (done-p stamp) + (let ((add-to-plan-p + (or (eql stamp t) (and niip (not done-p))))) + (cond + ((and add-to-plan-p (not niip)) + (revisit-harder)) + (t + (mark-component-visited + o c (make-instance 'action-status + :stamp stamp + :planned-p + (cond + (done-p + (mark-operation-done o c) + t) + (add-to-plan-p + (funcall collect (cons o c)) + (incf *visit-count*))))) + stamp)))))))))))) (defmethod traverse ((o operation) (c component)) (while-collecting (collect) (let ((*visit-count* 0)) - (traverse-action o c #'collect)))) + (traverse-action o c t #'collect)))) (defmethod perform ((o operation) (c source-file)) (sysdef-error diff --git a/test/test-missing-lisp-file.asd b/test/test-missing-lisp-file.asd index 5c32bb8f7196b33526f118cf619b8c7bd5be3567..605b4fcf443f5b48a34bcb8412ed920230f7fade 100644 --- a/test/test-missing-lisp-file.asd +++ b/test/test-missing-lisp-file.asd @@ -1,5 +1,5 @@ ;;; -*- Lisp -*- (asdf:defsystem test-missing-lisp-file - :components ((:file "file2" :in-order-to ((compile-op (load-op "fileMissing")))) + :components ((:file "file2" :in-order-to ((compile-op (load-op "fileMissing")) + (load-op (load-op "fileMissing")))) (:file "fileMissing"))) - diff --git a/test/test-samedir-modules.asd b/test/test-samedir-modules.asd index ae7f049b00fcb140578ea19b5dac66d66a76e5c8..274381e4f435c57c37598f19809f0a3a355a7179 100644 --- a/test/test-samedir-modules.asd +++ b/test/test-samedir-modules.asd @@ -2,8 +2,8 @@ (asdf:defsystem test-samedir-modules :components ((:module "here" :components - ( - (:file "file2" :in-order-to ((compile-op (load-op "file1")))) + ((:file "file2" :in-order-to ((compile-op (load-op "file1")) + (load-op (load-op "file1")))) (:file "file1")) :pathname ""))) diff --git a/test/test-samedir-modules.script b/test/test-samedir-modules.script index 07202716989afecb87b46951bae56e69a6661515..243d5c6dc3bdfb061c490f3391040af35fb412c0 100644 --- a/test/test-samedir-modules.script +++ b/test/test-samedir-modules.script @@ -4,16 +4,15 @@ (quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (DBG "loading test-samedir-modules") (asdf:operate 'asdf:load-op 'test-samedir-modules) - ;; test that it compiled (let* ((file1 (asdf:compile-file-pathname* "file1")) (file2 (asdf:compile-file-pathname* "file2")) (file1-date (file-write-date file1))) - (format t "~&test samedir modules 1: ~S ~S~%" file1 file1-date) + (DBG "test that it compiled" file1 file1-date) (assert file1-date) (assert (file-write-date file2)) - ;; and loaded + (DBG "and loaded") (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package))))) - diff --git a/test/test1.asd b/test/test1.asd index 3acad96ee4cabb2cc67ba2ea89e7c87f9c279d6d..862f2ad4cbc95dd31b1d1dfcf61aadc486cd9512 100644 --- a/test/test1.asd +++ b/test/test1.asd @@ -1,8 +1,8 @@ ;;; -*- Lisp -*- (asdf:defsystem test1 - :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")) + (load-op (load-op "file1")))) (:file "file1"))) - #| 1) from clean, check that all fasl files build and that some function defined in the second file is present diff --git a/test/test1.script b/test/test1.script index 22186edf783f623157a3a0eccf81f292e2b2b8fb..5354db533a15d91abaae64189b098d91d94bda43 100644 --- a/test/test1.script +++ b/test/test1.script @@ -4,14 +4,14 @@ (quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (DBG "loading test1") (asdf:load-system 'test1) - ;; test that it compiled (let* ((file1 (asdf:compile-file-pathname* "file1")) (file2 (asdf:compile-file-pathname* "file2")) (file1-date (file-write-date file1)) (file2-date (file-write-date file2))) - (format t "~&test1 1: ~S ~S~%" file1 file1-date) + (DBG "test that it compiled" file1 file1-date) (assert file1-date) (assert file2-date) @@ -22,7 +22,7 @@ (asdf::delete-file-if-exists file2) ;; filesystem mtime has 1 second granularity. Make sure even fast machines see a difference. (sleep 1.5) - (asdf:operate 'asdf:load-op 'test1) + (asdf:load-system 'test1) (assert (= file1-date (file-write-date file1))) (assert (< file2-date (file-write-date file2))) diff --git a/test/test2.asd b/test/test2.asd index bbfe4056b515cbdad0702dbc6a759464fc740cef..e3c759083b02d670470ae1b95ddb84da4328c82b 100644 --- a/test/test2.asd +++ b/test/test2.asd @@ -1,6 +1,7 @@ ;;; -*- Lisp -*- (asdf:defsystem test2b :version "1.0" - :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")) + (load-op (load-op "file1")))) (:file "file1")) :depends-on (version 'test2a "1.1")) diff --git a/test/test2.script b/test/test2.script index 7480123ae592d2587df3bf61b0647ff01ae0dcef..641d43d6d968924136a1bf03f3b3c6e82154abcf 100644 --- a/test/test2.script +++ b/test/test2.script @@ -2,25 +2,25 @@ (load "script-support.lisp") (load-asdf) (quit-on-error - (format t "test2 1~%") (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (asdf:oos 'asdf:load-op 'test2b1) - (format t "test2 2~%") + (DBG "test2: loading test2b1") + (asdf:load-system 'test2b1) + (DBG "test2: file3 and file4 were compiled") (assert (and (probe-file (asdf:compile-file-pathname* (truename "file3.lisp"))) (probe-file (asdf:compile-file-pathname* (truename "file4.lisp"))))) - (format t "test2 3~%") + (DBG "test2: loading test2b2 should fail") #-gcl (handler-case - (asdf:oos 'asdf:load-op 'test2b2) + (asdf:load-system 'test2b2) (asdf:missing-dependency (c) (format t "load failed as expected: - ~%~A~%" c)) (:no-error (c) (declare (ignore c)) (error "should have failed, oops"))) - (format t "test2 4~%") + (DBG "test2: loading test2b3 should fail") #-gcl (handler-case - (asdf:oos 'asdf:load-op 'test2b3) + (asdf:load-system 'test2b3) (asdf:missing-dependency (c) (format t "load failed as expected: - ~%~A~%" c)) (:no-error (c) diff --git a/test/test2a.asd b/test/test2a.asd index c9de77ee98c1e0862476f84f1a2354f4e95c762c..b488e396a114d8fdc669c3b261f6ca775256d354 100644 --- a/test/test2a.asd +++ b/test/test2a.asd @@ -1,12 +1,9 @@ ;;; -*- Lisp -*- (asdf:defsystem test2a :version "1.1" - :components ((:file "file4" :in-order-to ((compile-op (load-op "file3")))) + :components ((:file "file4" :in-order-to ((compile-op (load-op "file3")) + (load-op (load-op "file3")))) (:file "file3"))) #| this system is referenced by test2b[12] |# - - - - diff --git a/test/test2b1.asd b/test/test2b1.asd index f91f21e3a13dbb87b894c97bdee63d71e3f4954d..06987e0cf72a5d5742f480d92266abc57c3765a1 100644 --- a/test/test2b1.asd +++ b/test/test2b1.asd @@ -1,6 +1,7 @@ ;;; -*- Lisp -*- (asdf:defsystem test2b1 :version "1.0" - :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")) + (load-op (load-op "file1")))) (:file "file1")) :in-order-to ((load-op (load-op (:version test2a "1.1"))))) diff --git a/test/test2b2.asd b/test/test2b2.asd index 4c4cfb918b87ab6c9c614c594434e0343ec784a2..6faa9f5c2d897750a009a1ba7cb1f833cc2910f3 100644 --- a/test/test2b2.asd +++ b/test/test2b2.asd @@ -1,7 +1,8 @@ ;;; -*- Lisp -*- (asdf:defsystem test2b2 :version "1.0" - :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")) + (load-op (load-op "file1")))) (:file "file1")) :in-order-to ((load-op (load-op (:version test2a "1.2"))))) diff --git a/test/test2b3.asd b/test/test2b3.asd index 3ec8ae6b1a0a5ca5b759b47e6dcebf902e93c401..26c794a20c38e345877d801fe82af7e051e8e397 100644 --- a/test/test2b3.asd +++ b/test/test2b3.asd @@ -1,6 +1,7 @@ ;;; -*- Lisp -*- (asdf:defsystem test2b3 :version "1.0" - :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")) + (load-op (load-op "file1")))) (:file "file1")) :depends-on (bet-you-cant-find-this))