Skip to content
Snippets Groups Projects
Commit da0d1380 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.26.9: Another major rewrite of traverse, to propagate timestamps correctly.

This fixes the major issue whereby asdf's operation-done-p was failing to check
the timestamps of dependencies, only checking those of the immediate operation.
	https://bugs.launchpad.net/asdf/+bug/1087609

This rewrite is also a vast simplification:
* we rely purely on filesystem timestamps of files
* we stop using get-universal-time and therefore eschew clock skews issues
 between processor and filesystem
* we do away with the ugly do-first dependencies, previously made necessary
 by the way get-universal-time messed with load timestamps.
* we simplify the protocol to visit components, with a better internal API
 that we use twice: once, recursively, in traverse, and once, shallowly,
 in compute-action-stamp (the new internals for operation-done-p).
* make-sub-operation is drastically simplified.

For the sake of backward-compatibility, the code style had to be contrived,
notably introducing a special variable *stamp*,
supporting dual modes for operation-done-p, and
keeping the old names of many functions that would better be renamed.
parent 331df45f
No related branches found
No related tags found
No related merge requests found
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.8" ;; to be automatically updated by bin/bump-revision :version "2.26.9" ;; to be automatically updated by bin/bump-revision
:depends-on () :depends-on ()
:components :components
((:file "asdf"))) ((:file "asdf")))
...@@ -25,8 +25,9 @@ ...@@ -25,8 +25,9 @@
;; perform'ing the load-op'ing of the newly compiled asdf fasl because ;; perform'ing the load-op'ing of the newly compiled asdf fasl because
;; perform has been undefined during the initial package-frobbing eval-when code, ;; perform has been undefined during the initial package-frobbing eval-when code,
;; but not redefined yet by loading the code rather than merely compiling it. ;; but not redefined yet by loading the code rather than merely compiling it.
;; We could use (:file "asdf" :do-first ((compile-op (load-source-op "asdf")))) ;; Between ASDF 2.016.3 and 2.26.8, we could have used
;; but it's only supported since ASDF 2.016.3. What's below should be more compatible. ;; (:file "asdf" :do-first ((compile-op (load-source-op "asdf"))))
;; What's below should be more compatible.
;; We can't use find-component, because it's not compatible with old versions of ASDF 1.x ;; We can't use find-component, because it's not compatible with old versions of ASDF 1.x
(defmethod perform :before ((operation compile-op) (defmethod perform :before ((operation compile-op)
......
This diff is collapsed.
...@@ -229,8 +229,8 @@ http://ilc2009.scheming.org/ ...@@ -229,8 +229,8 @@ http://ilc2009.scheming.org/
:components ((:test-file "a") :components ((:test-file "a")
(:test-file "b" (:test-file "b"
:in-order-to ((asdf:compile-op (asdf:compile-op "a")) :in-order-to ((asdf:compile-op (asdf:compile-op "a"))
(asdf:load-op (asdf:load-op "a"))) (asdf:load-op (asdf:load-op "a"))
:do-first ((asdf:compile-op (asdf:load-op "a")))))) (asdf:compile-op (asdf:load-op "a"))))))
(define-test test-6 system-6 (define-test test-6 system-6
:operation-name asdf:compile-op :operation-name asdf:compile-op
...@@ -241,8 +241,6 @@ http://ilc2009.scheming.org/ ...@@ -241,8 +241,6 @@ http://ilc2009.scheming.org/
(:did-not-load "b"))) (:did-not-load "b")))
;; Should be just like test-3-b, but a does not get loaded. Why not? ;; Should be just like test-3-b, but a does not get loaded. Why not?
;; Because you can't really specify :do-first because it clobbers
;; the :do-first that you provide!
(define-test test-6-a system-6 (define-test test-6-a system-6
:operation-name asdf:compile-op :operation-name asdf:compile-op
:already-compiled () :already-compiled ()
......
...@@ -124,11 +124,14 @@ is bound, write a message and exit on an error. If ...@@ -124,11 +124,14 @@ is bound, write a message and exit on an error. If
(finish-output *standard-output*) (finish-output *standard-output*)
(finish-output *trace-output*) (finish-output *trace-output*)
(format *error-output* "~&ABORTING:~% ~S~%" c) (format *error-output* "~&ABORTING:~% ~S~%" c)
(finish-output *error-output*)
#+sbcl (sb-debug:backtrace 69) #+sbcl (sb-debug:backtrace 69)
#+clozure (ccl:print-call-history :count 69 :start-frame-number 1) #+clozure (ccl:print-call-history :count 69 :start-frame-number 1)
#+clisp (system::print-backtrace) #+clisp (system::print-backtrace)
(format *error-output* "~&ABORTING:~% ~S~%" c) (format *error-output* "~&ABORTING:~% ~S~%" c)
(finish-output *error-output*) (finish-output *error-output*)
(finish-output *standard-output*)
(finish-output *trace-output*)
(leave-lisp "~&Script failed~%" 1)))))) (leave-lisp "~&Script failed~%" 1))))))
(funcall thunk) (funcall thunk)
(leave-lisp "~&Script succeeded~%" 0))) (leave-lisp "~&Script succeeded~%" 0)))
......
...@@ -6,26 +6,24 @@ ...@@ -6,26 +6,24 @@
(defsystem :test-module-excessive-depend (defsystem :test-module-excessive-depend
:components ((:file "file1") :components ((:file "file1")
(:module "quux" (:module "quux"
:pathname #p"" :pathname ""
:depends-on ("file1") :depends-on ("file1")
:components ((:file "file2"))))) :components ((:file "file2")))))
(defun find-quux () (defun find-quux ()
(find-component (find-component :test-module-excessive-depend "quux"))
(find-system :test-module-excessive-depend)
"quux"))
(defun find-file2 () (defun find-file2 ()
(find-component (find-quux) "file2")) (find-component (find-quux) "file2"))
(defmethod component-depends-on ((op load-op) (defmethod component-depends-on ((op load-op)
(c (eql (find-file2)))) (c (eql (find-file2))))
(cons (cons 'load-op (list "file3-only")) (cons '(load-op "file3-only")
(call-next-method))) (call-next-method)))
(defmethod component-depends-on ((op compile-op) (defmethod component-depends-on ((op compile-op)
(c (eql (find-file2)))) (c (eql (find-file2))))
(cons (cons 'load-op (list "file3-only")) (cons '(load-op "file3-only")
(call-next-method))) (call-next-method)))
(defmethod find-component :around ((m (eql (find-quux))) (defmethod find-component :around ((m (eql (find-quux)))
......
...@@ -14,7 +14,6 @@ ...@@ -14,7 +14,6 @@
;;; and reloading of "file2," but /not/ of system Y. ;;; and reloading of "file2," but /not/ of system Y.
;;;--------------------------------------------------------------------------- ;;;---------------------------------------------------------------------------
(quit-on-error (quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'test-module-excessive-depend) (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
...@@ -47,11 +46,9 @@ ...@@ -47,11 +46,9 @@
(let ((plan (asdf::traverse (let ((plan (asdf::traverse
(make-instance 'asdf:load-op) (make-instance 'asdf:load-op)
(asdf:find-system 'test-module-excessive-depend))) (asdf:find-system 'test-module-excessive-depend)))
(file3-only (asdf:find-system 'file3-only))) (file3 (asdf:find-component :file3-only "file3")))
;;; (format t "~%Operation plan is:~%") #|(format t "~%Operation plan is:~%")(pprint plan)(terpri)|#
;;; (pprint plan) (when (loop :for (o . c) :in plan :thereis (and (eq c file3) (typep o 'asdf:compile-op)))
;;; (format t "Target system is: ~a" file3-only)
(when (find file3-only plan :key #'cdr)
(error "Excessive operations on file3-only system. Bad propagation of dependencies."))) (error "Excessive operations on file3-only system. Bad propagation of dependencies.")))
(asdf:operate 'asdf:load-op 'test-module-excessive-depend) (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
(assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before)) (assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment