Commit 65be1c38 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.46: only do things in-image if needed.

This restores the feature of do-first that was lost while refactoring ASDF
to fix the timestamp propagation issue.

The old asdf-bundle worked implicitly because of do-first:
fasl-op DEPENDS-ON compile-op, and compile-op has a DO-FIRST on the
load-op of dependencies, NOT a DEPENDS-ON, so if the compile-op is
"done" (which did NOT check the timestamps of dependencies),
then the dofirst is never consulted and load-op is never traversed.
In our new ASDF, we want to always traverse the load-op of dependencies,
so we can propagate their timestamps; however, we still want to only
actually load them if they are needed. Therefore, visiting actions
takes an additional flag "needed in this image", and each visited action
can be planned or not planned yet, and a not planned yet action can
be visited a second time to plan it after recursively visiting its
dependencies with the "needed" flag set.

Tests were fixed now to work now that this distinction exists.
parent 0efe021e
......@@ -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")))
......
;; -*- 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
......
;;; -*- 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")))
......@@ -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 "")))
......
......@@ -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)))))
;;; -*- 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
......
......@@ -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)))
......
;;; -*- 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"))
......@@ -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)
......
;;; -*- 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]
|#
;;; -*- 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")))))
;;; -*- 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")))))
......
;;; -*- 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))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment