diff --git a/src/contrib/asdf/asdf.lisp b/src/contrib/asdf/asdf.lisp index 855bd301d0a17b53114107bd61f31e9973cc715b..12f742eb0b7be396db5e13a0929f7f45d63d27ee 100644 --- a/src/contrib/asdf/asdf.lisp +++ b/src/contrib/asdf/asdf.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.2.1: Another System Definition Facility. +;;; This is ASDF 3.3.0: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. @@ -1087,8 +1087,9 @@ to supersede any previous definition." (with-upgradability () (defvar *uiop-debug-utility* '(or (ignore-errors - (symbol-call :asdf :system-relative-pathname :uiop "contrib/debug.lisp")) - (symbol-call :uiop/pathname :subpathname (user-homedir-pathname) "common-lisp/asdf/uiop/contrib/debug.lisp")) + (probe-file (symbol-call :asdf :system-relative-pathname :uiop "contrib/debug.lisp"))) + (probe-file (symbol-call :uiop/pathname :subpathname + (user-homedir-pathname) "common-lisp/asdf/uiop/contrib/debug.lisp"))) "form that evaluates to the pathname to your favorite debugging utilities") (defmacro uiop-debug (&rest keys) @@ -1108,7 +1109,7 @@ to supersede any previous definition." ;;; Flow control (with-upgradability () (defmacro nest (&rest things) - "Macro to do keep code nesting and indentation under control." ;; Thanks to mbaringer + "Macro to keep code nesting and indentation under control." ;; Thanks to mbaringer (reduce #'(lambda (outer inner) `(,@outer ,inner)) things :from-end t)) @@ -1379,26 +1380,26 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo (string (standard-case-symbol-name package-designator))) error))) -;;; stamps: a REAL or a boolean where NIL=-infinity, T=+infinity +;;; stamps: a REAL or a boolean where T=-infinity, NIL=+infinity (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) (deftype stamp () '(or real boolean))) (with-upgradability () (defun stamp< (x y) (etypecase x - (null (and y t)) - ((eql t) nil) + ((eql t) (not (eql y t))) (real (etypecase y - (null nil) - ((eql t) t) - (real (< x y)))))) + ((eql t) nil) + (real (< x y)) + (null t))) + (null nil))) (defun stamps< (list) (loop :for y :in list :for x = nil :then y :always (stamp< x y))) (defun stamp*< (&rest list) (stamps< list)) (defun stamp<= (x y) (not (stamp< y x))) (defun earlier-stamp (x y) (if (stamp< x y) x y)) - (defun stamps-earliest (list) (reduce 'earlier-stamp list :initial-value t)) + (defun stamps-earliest (list) (reduce 'earlier-stamp list :initial-value nil)) (defun earliest-stamp (&rest list) (stamps-earliest list)) (defun later-stamp (x y) (if (stamp< x y) y x)) - (defun stamps-latest (list) (reduce 'later-stamp list :initial-value nil)) + (defun stamps-latest (list) (reduce 'later-stamp list :initial-value t)) (defun latest-stamp (&rest list) (stamps-latest list)) (define-modify-macro latest-stamp-f (&rest stamps) latest-stamp)) @@ -1668,7 +1669,7 @@ message, that takes the functionality as its first argument (that can be skipped (in-package :uiop/version) (with-upgradability () - (defparameter *uiop-version* "3.2.1") + (defparameter *uiop-version* "3.3.0") (defun unparse-version (version-list) "From a parsed version (a list of natural numbers), compute the version string" @@ -2092,7 +2093,6 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (with-upgradability () (defun hostname () "return the hostname of the current host" - ;; Note: untested on RMCL #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance) #+cormanlisp "localhost" ;; is there a better way? Does it matter? #+allegro (symbol-call :excl.osi :gethostname) @@ -4420,8 +4420,9 @@ when the image is restarted, but before the entry point is called.") before the image dump hooks are called and before the image is dumped.") (defvar *image-dump-hook* nil - "Functions to call (in order) when before an image is dumped") + "Functions to call (in order) when before an image is dumped")) +(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) (deftype fatal-condition () `(and serious-condition #+clozure (not ccl:process-reset)))) @@ -4835,8 +4836,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." #+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files (append lisp-object-files #+(or clasp ecl) extra-object-files) #+ecl :init-name - #+ecl (c::compute-init-name (or output-name destination) - :kind (if (eq kind :fasb) :fasl kind)) + #+ecl (getf build-args :init-name) (append (when prologue-code `(:prologue-code ,prologue-code)) (when epilogue-code `(:epilogue-code ,epilogue-code)) @@ -5349,7 +5349,8 @@ possibly in a different process." :element-type *default-stream-element-type* :external-format *utf-8-external-format*) (with-safe-io-syntax () - (write (reify-deferred-warnings) :stream s :pretty t :readably t) + (let ((*read-eval* t)) + (write (reify-deferred-warnings) :stream s :pretty t :readably t)) (terpri s)))) (defun warnings-file-type (&optional implementation-type) @@ -5397,7 +5398,10 @@ re-intern and raise any warnings that are still meaningful." (reset-deferred-warnings) (dolist (file files) (unreify-deferred-warnings - (handler-case (safe-read-file-form file) + (handler-case + (with-safe-io-syntax () + (let ((*read-eval* t)) + (read-file-form file))) (error (c) ;;(delete-file-if-exists file) ;; deleting forces rebuild but prevents debugging (push c file-errors) @@ -5824,13 +5828,31 @@ argument to pass to the internal RUN-PROGRAM" (defun %signal-to-exit-code (signum) (+ 128 signum)) + (defun %code-to-status (exit-code signal-code) + (cond ((null exit-code) :running) + ((null signal-code) (values :exited exit-code)) + (t (values :signaled signal-code)))) + #+mkcl (defun %mkcl-signal-to-number (signal) (require :mk-unix) (symbol-value (find-symbol signal :mk-unix))) (defclass process-info () - ((process :initform nil) + (;; The process field is highly platform-, implementation-, and + ;; even version-dependent. + ;; Prior to LispWorks 7, the only information that + ;; `sys:run-shell-command` with `:wait nil` was certain to return + ;; is a PID (e.g. when all streams are nil), hence we stored it + ;; and used `sys:pid-exit-status` to obtain an exit status + ;; later. That is still what we do. + ;; From LispWorks 7 on, if `sys:run-shell-command` does not + ;; return a proper stream, we are instead given a dummy stream. + ;; We can thus always store a stream and use + ;; `sys:pipe-exit-status` to obtain an exit status later. + ;; The advantage of dealing with streams instead of PID is the + ;; availability of functions like `sys:pipe-kill-process`. + (process :initform nil) (input-stream :initform nil) (output-stream :initform nil) (bidir-stream :initform nil) @@ -5901,40 +5923,51 @@ argument to pass to the internal RUN-PROGRAM" (if-let (process (slot-value process-info 'process)) (multiple-value-bind (status code) (progn - #+allegro (multiple-value-bind (exit-code pid signal) + #+allegro (multiple-value-bind (exit-code pid signal-code) (sys:reap-os-subprocess :pid process :wait nil) (assert pid) - (cond ((null exit-code) :running) - ((null signal) (values :exited exit-code)) - (t (values :signaled signal)))) + (%code-to-status exit-code signal-code)) #+clozure (ccl:external-process-status process) #+(or cmucl scl) (let ((status (ext:process-status process))) - (values status (if (member status '(:exited :signaled)) - (ext:process-exit-code process)))) + (if (member status '(:exited :signaled)) + ;; Calling ext:process-exit-code on + ;; processes that are still alive + ;; yields an undefined result + (values status (ext:process-exit-code process)) + status)) #+ecl (ext:external-process-status process) #+lispworks ;; a signal is only returned on LispWorks 7+ - (multiple-value-bind (exit-code signal) - (funcall #+lispworks7+ #'sys:pipe-exit-status - #-lispworks7+ #'sys:pid-exit-status - process :wait nil) - (cond ((null exit-code) :running) - ((null signal) (values :exited exit-code)) - (t (values :signaled signal)))) - #+mkcl (let ((status (mk-ext:process-status process)) - (code (mk-ext:process-exit-code process))) - (if (stringp code) - (values :signaled (%mkcl-signal-to-number code)) - (values status code))) + (multiple-value-bind (exit-code signal-code) + (symbol-call :sys + #+lispworks7+ :pipe-exit-status + #-lispworks7+ :pid-exit-status + process :wait nil) + (%code-to-status exit-code signal-code)) + #+mkcl (let ((status (mk-ext:process-status process))) + (if (eq status :exited) + ;; Only call mk-ext:process-exit-code when + ;; necessary since it leads to another waitpid() + (let ((code (mk-ext:process-exit-code process))) + (if (stringp code) + (values :signaled (%mkcl-signal-to-number code)) + (values :exited code))) + status)) #+sbcl (let ((status (sb-ext:process-status process))) - (values status (if (member status '(:exited :signaled)) - (sb-ext:process-exit-code process))))) + (if (eq status :running) + :running + ;; sb-ext:process-exit-code can also be + ;; called for stopped processes to determine + ;; the signal that stopped them + (values status (sb-ext:process-exit-code process))))) (case status (:exited (setf (slot-value process-info 'exit-code) code)) (:signaled (let ((%code (%signal-to-exit-code code))) (setf (slot-value process-info 'exit-code) %code (slot-value process-info 'signal-code) code)))) - (values status code)))) + (if code + (values status code) + status)))) (defun process-alive-p (process-info) "Check if a process has yet to exit." @@ -5942,8 +5975,8 @@ argument to pass to the internal RUN-PROGRAM" #+abcl (sys:process-alive-p (slot-value process-info 'process)) #+(or cmucl scl) (ext:process-alive-p (slot-value process-info 'process)) #+sbcl (sb-ext:process-alive-p (slot-value process-info 'process)) - #-(or abcl cmucl sbcl scl) (member (%process-status process-info) - '(:running :sleeping)))) + #-(or abcl cmucl sbcl scl) (find (%process-status process-info) + '(:running :stopped :continued :resumed)))) (defun wait-process (process-info) "Wait for the process to terminate, if it is still running. @@ -5990,9 +6023,10 @@ might otherwise be irrevocably lost." (if (eq status :signaled) (values nil code) code)) - #+lispworks (funcall #+lispworks7+ #'sys:pipe-exit-status - #-lispworks7+ #'sys:pid-exit-status - process :wait t) + #+lispworks (symbol-call :sys + #+lispworks7+ :pipe-exit-status + #-lispworks7+ :pid-exit-status + process :wait t) #+mkcl (let ((code (mkcl:join-process process))) (if (stringp code) (values nil (%mkcl-signal-to-number code)) @@ -6041,14 +6075,13 @@ to ignore if URGENT is T. On some platforms, it may also be subject to race conditions." (declare (ignorable urgent)) #+abcl (sys:process-kill (slot-value process-info 'process)) - #+clasp (mp:process-kill (slot-value process-info 'process)) ;; On ECL, this will only work on versions later than 2016-09-06, ;; but we still want to compile on earlier versions, so we use symbol-call #+ecl (symbol-call :ext :terminate-process (slot-value process-info 'process) urgent) #+lispworks7+ (sys:pipe-kill-process (slot-value process-info 'process)) #+mkcl (mk-ext:terminate-process (slot-value process-info 'process) :force urgent) - #-(or abcl clasp ecl lispworks7+ mkcl) + #-(or abcl ecl lispworks7+ mkcl) (os-cond ((os-unix-p) (%posix-send-signal process-info (if urgent 9 15))) ((os-windows-p) (if-let (pid (process-info-pid process-info)) @@ -6284,18 +6317,18 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object." (prop (case mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream)) stream)) (prop 'process process)) #+lispworks + ;; See also the comments on the process-info class (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0)))) (cond ((or (plusp mode) (eq error-output :stream)) (prop 'process #+lispworks7+ io-or-pid #-lispworks7+ pid-or-nil) (when (plusp mode) - (prop (ecase mode - (1 'input-stream) - (2 'output-stream) - (3 'bidir-stream)) io-or-pid)) + (prop (ecase mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream)) + io-or-pid)) (when (eq error-output :stream) (prop 'error-stream err-or-nil))) - ;; lispworks6 returns (pid), lispworks7 returns (io err pid) of which we keep io + ;; Prior to Lispworks 7, this returned (pid); now it + ;; returns (io err pid) of which we keep io. (t (prop 'process io-or-pid))))) process-info))) @@ -6710,7 +6743,7 @@ or whether it's already taken care of by the implementation's underlying run-pro (reduce/strcat (os-cond ((os-unix-p) `(,@(when redirections `("exec " ,@redirections " ; ")) ,@chdir ,normalized)) - ((os-windows-p) `(,@chdir ,@redirections " " ,normalized))))))) + ((os-windows-p) `(,@redirections " (" ,@chdir ,normalized ")"))))))) (defun %system (command &rest keys &key directory input (if-input-does-not-exist :error) @@ -7303,7 +7336,7 @@ objects. Side-effects for cached file location computation." (in-package :uiop/backward-driver) (eval-when (:compile-toplevel :load-toplevel :execute) -(with-deprecation ((version-deprecation *uiop-version* :style-warning "3.2")) +(with-deprecation ((version-deprecation *uiop-version* :style-warning "3.2" :warning "3.4")) ;; Backward compatibility with ASDF 2.000 to 2.26 ;; For backward-compatibility only, for people using internals @@ -7470,7 +7503,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.2.1") + (asdf-version "3.3.0") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -7482,32 +7515,32 @@ previously-loaded version of ASDF." ;;; Upon upgrade, specially frob some functions and classes that are being incompatibly redefined (when-upgrading () - (let ((redefined-functions ;; List of functions that changes incompatibly since 2.27: - ;; gf signature changed (should NOT happen), defun that became a generic function, - ;; method removed that will mess up with new ones (especially :around :before :after, - ;; more specific or call-next-method'ed method) and/or semantics otherwise modified. Oops. - ;; NB: it's too late to do anything about functions in UIOP! - ;; If you introduce some critical incompatibility there, you must change the function name. - ;; Note that we don't need do anything about functions that changed incompatibly - ;; from ASDF 2.26 or earlier: we wholly punt on the entire ASDF package in such an upgrade. - ;; Also note that we don't include the defgeneric=>defun, because they are - ;; done directly with defun* and need not trigger a punt on data. - ;; See discussion at https://gitlab.common-lisp.net/asdf/asdf/merge_requests/36 - '(#:component-depends-on #:input-files ;; methods removed before 3.1.2 - #:find-component ;; gf modified in 3.1.7.20 - )) - (redefined-classes - ;; redefining the classes causes interim circularities - ;; with the old ASDF during upgrade, and many implementations bork - #-clozure () - #+clozure - '((#:compile-concatenated-source-op (#:operation) ()) - (#:compile-bundle-op (#:operation) ()) - (#:concatenate-source-op (#:operation) ()) - (#:dll-op (#:operation) ()) - (#:lib-op (#:operation) ()) - (#:monolithic-compile-bundle-op (#:operation) ()) - (#:monolithic-concatenate-source-op (#:operation) ())))) + (let* ((previous-version (first *previous-asdf-versions*)) + (redefined-functions ;; List of functions that changes incompatibly since 2.27: + ;; gf signature changed (should NOT happen), defun that became a generic function, + ;; method removed that will mess up with new ones (especially :around :before :after, + ;; more specific or call-next-method'ed method) and/or semantics otherwise modified. Oops. + ;; NB: it's too late to do anything about functions in UIOP! + ;; If you introduce some critical incompatibility there, you must change the function name. + ;; Note that we don't need do anything about functions that changed incompatibly + ;; from ASDF 2.26 or earlier: we wholly punt on the entire ASDF package in such an upgrade. + ;; Also note that we don't include the defgeneric=>defun, because they are + ;; done directly with defun* and need not trigger a punt on data. + ;; See discussion at https://gitlab.common-lisp.net/asdf/asdf/merge_requests/36 + `(,@(when (version<= previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2 + ,@(when (version<= previous-version "3.1.7.20") '(#:find-component)))) + (redefined-classes + ;; redefining the classes causes interim circularities + ;; with the old ASDF during upgrade, and many implementations bork + #-clozure () + #+clozure + '((#:compile-concatenated-source-op (#:operation) ()) + (#:compile-bundle-op (#:operation) ()) + (#:concatenate-source-op (#:operation) ()) + (#:dll-op (#:operation) ()) + (#:lib-op (#:operation) ()) + (#:monolithic-compile-bundle-op (#:operation) ()) + (#:monolithic-concatenate-source-op (#:operation) ())))) (loop :for name :in redefined-functions :for sym = (find-symbol* name :asdf nil) :do (when sym (fmakunbound sym))) @@ -7556,49 +7589,107 @@ previously-loaded version of ASDF." (with-deprecation ((version-deprecation *asdf-version* ,@keys)) ,@body)))) ;;;; ------------------------------------------------------------------------- -;;;; Session cache +;;;; Session -(uiop/package:define-package :asdf/cache +(uiop/package:define-package :asdf/session + (:recycle :asdf/session :asdf/cache :asdf/component + :asdf/action :asdf/find-system :asdf/plan :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade) - (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp - #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache - #:do-asdf-cache #:normalize-namestring - #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache* - #:clear-configuration-and-retry #:retry)) -(in-package :asdf/cache) - -;;; The ASDF session cache is used to memoize some computations. It is instrumental in achieving: -;; * Consistency in the view of the world relied on by ASDF within a given session. -;; Inconsistencies in file stamps, system definitions, etc., could cause infinite loops -;; (a.k.a. stack overflows) and other erratic behavior. -;; * Speed and reliability of ASDF, with fewer side-effects from access to the filesystem, and -;; no expensive recomputations of transitive dependencies for some input-files or output-files. -;; * Testability of ASDF with the ability to fake timestamps without actually touching files. - -(with-upgradability () - ;; The session cache variable. - ;; NIL when outside a session, an equal hash-table when inside a session. - (defvar *asdf-cache* nil) + (:export + #:get-file-stamp #:compute-file-stamp #:register-file-stamp + #:asdf-cache #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache + #:do-asdf-cache #:normalize-namestring + #:call-with-asdf-session #:with-asdf-session + #:*asdf-session* #:*asdf-session-class* #:session #:toplevel-asdf-session + #:session-cache #:forcing #:asdf-upgraded-p + #:visited-actions #:visiting-action-set #:visiting-action-list + #:total-action-count #:planned-action-count #:planned-output-action-count + #:clear-configuration-and-retry #:retry + #:operate-level + ;; conditions + #:system-definition-error ;; top level, moved here because this is the earliest place for it. + #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error)) +(in-package :asdf/session) + + +(with-upgradability () + ;; The session variable. + ;; NIL when outside a session. + (defvar *asdf-session* nil) + (defparameter* *asdf-session-class* 'session + "The default class for sessions") + + (defclass session () + (;; The ASDF session cache is used to memoize some computations. + ;; It is instrumental in achieving: + ;; * Consistency in the view of the world relied on by ASDF within a given session. + ;; Inconsistencies in file stamps, system definitions, etc., could cause infinite loops + ;; (a.k.a. stack overflows) and other erratic behavior. + ;; * Speed and reliability of ASDF, with fewer side-effects from access to the filesystem, and + ;; no expensive recomputations of transitive dependencies for input-files or output-files. + ;; * Testability of ASDF with the ability to fake timestamps without actually touching files. + (ancestor + :initform nil :initarg :ancestor :reader session-ancestor + :documentation "Top level session that this is part of") + (session-cache + :initform (make-hash-table :test 'equal) :initarg :session-cache :reader session-cache + :documentation "Memoize expensive computations") + (operate-level + :initform 0 :initarg :operate-level :accessor session-operate-level + :documentation "Number of nested calls to operate we're under (for toplevel session only)") + ;; shouldn't the below be superseded by the session-wide caching of action-status + ;; for (load-op "asdf") ? + (asdf-upgraded-p + :initform nil :initarg :asdf-upgraded-p :accessor asdf-upgraded-p + :documentation "Was ASDF already upgraded in this session - only valid for toplevel-asdf-session.") + (forcing + :initform nil :initarg :forcing :accessor forcing + :documentation "Forcing parameters for the session") + ;; Table that to actions already visited while walking the dependencies associates status + (visited-actions :initform (make-hash-table :test 'equal) :accessor visited-actions) + ;; Actions that depend on those being currently walked through, to detect circularities + (visiting-action-set ;; as a set + :initform (make-hash-table :test 'equal) :accessor visiting-action-set) + (visiting-action-list :initform () :accessor visiting-action-list) ;; as a list + ;; Counts of total actions in plan + (total-action-count :initform 0 :accessor total-action-count) + ;; Count of actions that need to be performed + (planned-action-count :initform 0 :accessor planned-action-count) + ;; Count of actions that need to be performed that have a non-empty list of output-files. + (planned-output-action-count :initform 0 :accessor planned-output-action-count)) + (:documentation "An ASDF session with a cache to memoize some computations")) + + (defun toplevel-asdf-session () + (when *asdf-session* (or (session-ancestor *asdf-session*) *asdf-session*))) + + (defun operate-level () + (session-operate-level (toplevel-asdf-session))) + + (defun (setf operate-level) (new-level) + (setf (session-operate-level (toplevel-asdf-session)) new-level)) + + (defun asdf-cache () + (session-cache *asdf-session*)) ;; Set a session cache entry for KEY to a list of values VALUE-LIST, when inside a session. ;; Return those values. (defun set-asdf-cache-entry (key value-list) - (values-list (if *asdf-cache* - (setf (gethash key *asdf-cache*) value-list) + (values-list (if *asdf-session* + (setf (gethash key (asdf-cache)) value-list) value-list))) ;; Unset the session cache entry for KEY, when inside a session. (defun unset-asdf-cache-entry (key) - (when *asdf-cache* - (remhash key *asdf-cache*))) + (when *asdf-session* + (remhash key (session-cache *asdf-session*)))) ;; Consult the session cache entry for KEY if present and in a session; ;; if not present, compute it by calling the THUNK, ;; and set the session cache entry accordingly, if in a session. ;; Return the values from the cache and/or the thunk computation. (defun consult-asdf-cache (key &optional thunk) - (if *asdf-cache* - (multiple-value-bind (results foundp) (gethash key *asdf-cache*) + (if *asdf-session* + (multiple-value-bind (results foundp) (gethash key (session-cache *asdf-session*)) (if foundp (values-list results) (set-asdf-cache-entry key (multiple-value-list (call-function thunk))))) @@ -7614,13 +7705,20 @@ previously-loaded version of ASDF." ;; Second, if a new session was started, establish restarts for retrying the overall computation. ;; Finally, consult the cache if a KEY was specified with the THUNK as a fallback when the cache ;; entry isn't found, or just call the THUNK if no KEY was specified. - (defun call-with-asdf-cache (thunk &key override key) + (defun call-with-asdf-session (thunk &key override key override-cache override-forcing) (let ((fun (if key #'(lambda () (consult-asdf-cache key thunk)) thunk))) - (if (and *asdf-cache* (not override)) + (if (and (not override) *asdf-session*) (funcall fun) (loop (restart-case - (let ((*asdf-cache* (make-hash-table :test 'equal))) + (let ((*asdf-session* + (apply 'make-instance *asdf-session-class* + (when *asdf-session* + `(:ancestor ,(toplevel-asdf-session) + ,@(unless override-forcing + `(:forcing ,(forcing *asdf-session*))) + ,@(unless override-cache + `(:session-cache ,(session-cache *asdf-session*)))))))) (return (funcall fun))) (retry () :report (lambda (s) @@ -7628,11 +7726,15 @@ previously-loaded version of ASDF." (clear-configuration-and-retry () :report (lambda (s) (format s (compatfmt "~@<Retry ASDF operation after resetting the configuration.~@:>"))) + (clrhash (session-cache *asdf-session*)) (clear-configuration))))))) - ;; Syntactic sugar for call-with-asdf-cache - (defmacro with-asdf-cache ((&key key override) &body body) - `(call-with-asdf-cache #'(lambda () ,@body) :override ,override :key ,key)) + ;; Syntactic sugar for call-with-asdf-session + (defmacro with-asdf-session ((&key key override override-cache override-forcing) &body body) + `(call-with-asdf-session + #'(lambda () ,@body) + :override ,override :key ,key + :override-cache ,override-cache :override-forcing ,override-forcing)) ;;; Define specific accessor for file (date) stamp. @@ -7648,7 +7750,7 @@ previously-loaded version of ASDF." ;; Compute the file stamp for a normalized namestring (defun compute-file-stamp (normalized-namestring) (with-pathname-defaults () - (safe-file-write-date normalized-namestring))) + (or (safe-file-write-date normalized-namestring) t))) ;; Override the time STAMP associated to a given FILE in the session cache. ;; If no STAMP is specified, recompute a new one from the filesystem. @@ -7661,16 +7763,38 @@ previously-loaded version of ASDF." (defun get-file-stamp (file) (when file (let ((namestring (normalize-namestring file))) - (do-asdf-cache `(get-file-stamp ,namestring) (compute-file-stamp namestring)))))) + (do-asdf-cache `(get-file-stamp ,namestring) (compute-file-stamp namestring))))) + + + ;;; Conditions + + (define-condition system-definition-error (error) () + ;; [this use of :report should be redundant, but unfortunately it's not. + ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-function + ;; over print-object; this is always conditions::%print-condition for + ;; condition objects, which in turn does inheritance of :report options at + ;; run-time. fortunately, inheritance means we only need this kludge here in + ;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.] + #+cmucl (:report print-object)) + + (define-condition formatted-system-definition-error (system-definition-error) + ((format-control :initarg :format-control :reader format-control) + (format-arguments :initarg :format-arguments :reader format-arguments)) + (:report (lambda (c s) + (apply 'format s (format-control c) (format-arguments c))))) + (defun sysdef-error (format &rest arguments) + (error 'formatted-system-definition-error :format-control + format :format-arguments arguments))) ;;;; ------------------------------------------------------------------------- ;;;; Components (uiop/package:define-package :asdf/component - (:recycle :asdf/component :asdf/defsystem :asdf/find-system :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade) + (:recycle :asdf/component :asdf/find-component :asdf) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session) (:export #:component #:component-find-path + #:find-component ;; methods defined in find-component #:component-name #:component-pathname #:component-relative-pathname #:component-parent #:component-system #:component-parent-pathname #:child-component #:parent-component #:module @@ -7694,7 +7818,6 @@ previously-loaded version of ASDF." #:sub-components ;; conditions - #:system-definition-error ;; top level, moved here because this is the earliest place for it. #:duplicate-names ;; Internals we'd like to share with the ASDF package, especially for upgrade purposes @@ -7746,15 +7869,6 @@ or NIL for top-level components (a.k.a. systems)")) (defgeneric source-file-type (component system) (:documentation "DEPRECATED. Use the FILE-TYPE of a COMPONENT instead.")) - (define-condition system-definition-error (error) () - ;; [this use of :report should be redundant, but unfortunately it's not. - ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-function - ;; over print-object; this is always conditions::%print-condition for - ;; condition objects, which in turn does inheritance of :report options at - ;; run-time. fortunately, inheritance means we only need this kludge here in - ;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.] - #+cmucl (:report print-object)) - (define-condition duplicate-names (system-definition-error) ((name :initarg :name :reader duplicate-names-name)) (:report (lambda (c s) @@ -7812,9 +7926,15 @@ or NIL for top-level components (a.k.a. systems)")) ;; For backward-compatibility, this slot is part of component rather than of child-component. ASDF4: stop it. (parent :initarg :parent :initform nil :reader component-parent) (build-operation - :initarg :build-operation :initform nil :reader component-build-operation)) + :initarg :build-operation :initform nil :reader component-build-operation) + ;; Cache for ADDITIONAL-INPUT-FILES function. + (additional-input-files :accessor %additional-input-files :initform nil)) (:documentation "Base class for all components of a build")) + (defgeneric find-component (base path &key registered) + (:documentation "Find a component by resolving the PATH starting from BASE parent. +If REGISTERED is true, only search currently registered systems.")) + (defun component-find-path (component) "Return a path from a root system to the COMPONENT. The return value is a list of component NAMES; a list of strings." @@ -7998,19 +8118,94 @@ this compilation, or check its results, etc.")) (map () #'recurse (component-children x)))))) (recurse component))))) +;;;; ------------------------------------------------------------------------- +;;;; Operations + +(uiop/package:define-package :asdf/operation + (:recycle :asdf/operation :asdf/action :asdf) ;; asdf/action for FEATURE pre 2.31.5. + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session) + (:export + #:operation + #:*operations* #:make-operation #:find-operation + #:feature)) ;; TODO: stop exporting the deprecated FEATURE feature. +(in-package :asdf/operation) + +;;; Operation Classes +(when-upgrading (:version "2.27" :when (find-class 'operation nil)) + ;; override any obsolete shared-initialize method when upgrading from ASDF2. + (defmethod shared-initialize :after ((o operation) (slot-names t) &key) + (values))) + +(with-upgradability () + (defclass operation () + () + (:documentation "The base class for all ASDF operations. + +ASDF does NOT and never did distinguish between multiple operations of the same class. +Therefore, all slots of all operations MUST have :allocation :class and no initargs. No exceptions. +")) + + (defvar *in-make-operation* nil) + + (defun check-operation-constructor () + "Enforce that OPERATION instances must be created with MAKE-OPERATION." + (unless *in-make-operation* + (sysdef-error "OPERATION instances must only be created through MAKE-OPERATION."))) + + (defmethod print-object ((o operation) stream) + (print-unreadable-object (o stream :type t :identity nil))) + + ;;; Override previous methods (from 3.1.7 and earlier) and add proper error checking. + #-genera ;; Genera adds its own system initargs, e.g. clos-internals:storage-area 8 + (defmethod initialize-instance :after ((o operation) &rest initargs &key &allow-other-keys) + (unless (null initargs) + (parameter-error "~S does not accept initargs" 'operation)))) + + +;;; make-operation, find-operation + +(with-upgradability () + ;; A table to memoize instances of a given operation. There shall be only one. + (defparameter* *operations* (make-hash-table :test 'equal)) + + ;; A memoizing way of creating instances of operation. + (defun make-operation (operation-class) + "This function creates and memoizes an instance of OPERATION-CLASS. +All operation instances MUST be created through this function. + +Use of INITARGS is not supported at this time." + (let ((class (coerce-class operation-class + :package :asdf/interface :super 'operation :error 'sysdef-error)) + (*in-make-operation* t)) + (ensure-gethash class *operations* `(make-instance ,class)))) + + ;; This function is mostly for backward and forward compatibility: + ;; operations used to preserve the operation-original-initargs of the context, + ;; and may in the future preserve some operation-canonical-initargs. + ;; Still, the treatment of NIL as a disabling context is useful in some cases. + (defgeneric find-operation (context spec) + (:documentation "Find an operation by resolving the SPEC in the CONTEXT")) + (defmethod find-operation ((context t) (spec operation)) + spec) + (defmethod find-operation ((context t) (spec symbol)) + (when spec ;; NIL designates itself, i.e. absence of operation + (make-operation spec))) ;; TODO: preserve the (operation-canonical-initargs context) + (defmethod find-operation ((context t) (spec string)) + (make-operation spec))) ;; TODO: preserve the (operation-canonical-initargs context) + ;;;; ------------------------------------------------------------------------- ;;;; Systems (uiop/package:define-package :asdf/system - (:recycle :asdf :asdf/system) - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component) + (:recycle :asdf :asdf/system :asdf/find-system) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session :asdf/component) (:export - #:system #:proto-system + #:system #:proto-system #:undefined-system #:reset-system-class #:system-source-file #:system-source-directory #:system-relative-pathname - #:reset-system #:system-description #:system-long-description #:system-author #:system-maintainer #:system-licence #:system-license - #:system-defsystem-depends-on #:system-depends-on #:system-weakly-depends-on + #:definition-dependency-list #:definition-dependency-set #:system-defsystem-depends-on + #:system-depends-on #:system-weakly-depends-on #:component-build-pathname #:build-pathname #:component-entry-point #:entry-point #:homepage #:system-homepage @@ -8018,6 +8213,7 @@ this compilation, or check its results, etc.")) #:mailto #:system-mailto #:long-name #:system-long-name #:source-control #:system-source-control + #:coerce-name #:primary-system-name #:primary-system-p #:coerce-filename #:find-system #:builtin-system-p)) ;; forward-reference, defined in find-system (in-package :asdf/system) @@ -8059,7 +8255,14 @@ NB: This interface is subject to change. Please contact ASDF maintainers if you (defclass proto-system () ; slots to keep when resetting a system ;; To preserve identity for all objects, we'd need keep the components slots ;; but also to modify parse-component-form to reset the recycled objects. - ((name) (source-file) #|(children) (children-by-names)|#) + ((name) + (source-file) + ;; These two slots contains the *inferred* dependencies of define-op, + ;; from loading the .asd file, as list and as set. + (definition-dependency-list + :initform nil :accessor definition-dependency-list) + (definition-dependency-set + :initform (list-to-hash-set nil) :accessor definition-dependency-set)) (:documentation "PROTO-SYSTEM defines the elements of identity that are preserved when a SYSTEM is redefined and its class is modified.")) @@ -8085,6 +8288,7 @@ a SYSTEM is redefined and its class is modified.")) (entry-point :initform nil :initarg :entry-point :accessor component-entry-point) (source-file :initform nil :initarg :source-file :accessor system-source-file) + ;; This slot contains the *declared* defsystem-depends-on dependencies (defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on :initform nil) ;; these two are specially set in parse-component-form, so have no :INITARGs. @@ -8093,14 +8297,54 @@ a SYSTEM is redefined and its class is modified.")) (:documentation "SYSTEM is the base class for top-level components that users may request ASDF to build.")) + (defclass undefined-system (system) () + (:documentation "System that was not defined yet.")) - (defun reset-system (system &rest keys &key &allow-other-keys) + (defun reset-system-class (system new-class &rest keys &key &allow-other-keys) "Erase any data from a SYSTEM except its basic identity, then reinitialize it based on supplied KEYS." - (change-class (change-class system 'proto-system) 'system) + (change-class (change-class system 'proto-system) new-class) (apply 'reinitialize-instance system keys))) +;;; Canonicalizing system names + +(with-upgradability () + (defun coerce-name (name) + "Given a designator for a component NAME, return the name as a string. +The designator can be a COMPONENT (designing its name; note that a SYSTEM is a component), +a SYMBOL (designing its name, downcased), or a STRING (designing itself)." + (typecase name + (component (component-name name)) + (symbol (string-downcase name)) + (string name) + (t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name)))) + + (defun primary-system-name (system-designator) + "Given a system designator NAME, return the name of the corresponding primary system, +after which the .asd file is named. That's the first component when dividing the name +as a string by / slashes. A component designates its system." + (etypecase system-designator + (string (if-let (p (position #\/ system-designator)) + (subseq system-designator 0 p) system-designator)) + (symbol (primary-system-name (coerce-name system-designator))) + (component (primary-system-name (coerce-name (component-system system-designator)))))) + + (defun primary-system-p (system) + "Given a system designator SYSTEM, return T if it designates a primary system, or else NIL. +Also return NIL if system is neither a SYSTEM nor a string designating one." + (typecase system + (string (not (find #\/ system))) + (system (primary-system-p (coerce-name system))))) + + (defun coerce-filename (name) + "Coerce a system designator NAME into a string suitable as a filename component. +The (current) transformation is to replace characters /:\\ each by --, +the former being forbidden in a filename component. +NB: The onus is unhappily on the user to avoid clashes." + (frob-substrings (coerce-name name) '("/" ":" "\\") "--"))) + + ;;;; Pathnames (with-upgradability () @@ -8157,112 +8401,45 @@ return the absolute pathname of a corresponding file under that system's source ;;;; ------------------------------------------------------------------------- ;;;; Finding systems -(uiop/package:define-package :asdf/find-system - (:recycle :asdf/find-system :asdf) +(uiop/package:define-package :asdf/system-registry + (:recycle :asdf/system-registry :asdf/find-system :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade - :asdf/cache :asdf/component :asdf/system) + :asdf/session :asdf/component :asdf/system) (:export #:remove-entry-from-registry #:coerce-entry-to-directory - #:coerce-name #:primary-system-name #:coerce-filename - #:find-system #:locate-system #:load-asd - #:system-registered-p #:registered-system #:register-system + #:registered-system #:register-system #:registered-systems* #:registered-systems #:clear-system #:map-systems - #:missing-component #:missing-requires #:missing-parent - #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error - #:load-system-definition-error #:error-name #:error-pathname #:error-condition #:*system-definition-search-functions* #:search-for-system-definition #:*central-registry* #:probe-asd #:sysdef-central-registry-search - #:find-system-if-being-defined #:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed #:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems* - #:mark-component-preloaded ;; forward reference to asdf/operate + #:find-system-if-being-defined #:mark-component-preloaded ;; forward references to asdf/find-system #:sysdef-immutable-system-search #:register-immutable-system #:*immutable-systems* - #:*defined-systems* #:clear-defined-systems + #:*registered-systems* #:clear-registered-systems ;; defined in source-registry, but specially mentioned here: - #:initialize-source-registry #:sysdef-source-registry-search)) -(in-package :asdf/find-system) + #:sysdef-source-registry-search)) +(in-package :asdf/system-registry) (with-upgradability () - (declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference - - (define-condition missing-component (system-definition-error) - ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires) - (parent :initform nil :reader missing-parent :initarg :parent))) - - (define-condition formatted-system-definition-error (system-definition-error) - ((format-control :initarg :format-control :reader format-control) - (format-arguments :initarg :format-arguments :reader format-arguments)) - (:report (lambda (c s) - (apply 'format s (format-control c) (format-arguments c))))) - - (define-condition load-system-definition-error (system-definition-error) - ((name :initarg :name :reader error-name) - (pathname :initarg :pathname :reader error-pathname) - (condition :initarg :condition :reader error-condition)) - (:report (lambda (c s) - (format s (compatfmt "~@<Error while trying to load definition for system ~A from pathname ~A: ~3i~_~A~@:>") - (error-name c) (error-pathname c) (error-condition c))))) - - (defun sysdef-error (format &rest arguments) - (error 'formatted-system-definition-error :format-control - format :format-arguments arguments)) - - - ;;; Canonicalizing system names - - (defun coerce-name (name) - "Given a designator for a component NAME, return the name as a string. -The designator can be a COMPONENT (designing its name; note that a SYSTEM is a component), -a SYMBOL (designing its name, downcased), or a STRING (designing itself)." - (typecase name - (component (component-name name)) - (symbol (string-downcase name)) - (string name) - (t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name)))) - - (defun primary-system-name (name) - "Given a system designator NAME, return the name of the corresponding primary system, -after which the .asd file is named. That's the first component when dividing the name -as a string by / slashes." - (first (split-string (coerce-name name) :separator "/"))) - - (defun coerce-filename (name) - "Coerce a system designator NAME into a string suitable as a filename component. -The (current) transformation is to replace characters /:\\ each by --, -the former being forbidden in a filename component. -NB: The onus is unhappily on the user to avoid clashes." - (frob-substrings (coerce-name name) '("/" ":" "\\") "--")) - - ;;; Registry of Defined Systems - (defvar *defined-systems* (make-hash-table :test 'equal) - "This is a hash table whose keys are strings -- the -names of systems -- and whose values are pairs, the first -element of which is a universal-time indicating when the -system definition was last updated, and the second element -of which is a system object. - A system is referred to as \"registered\" if it is present -in this table.") - - (defun system-registered-p (name) - "Return a generalized boolean that is true if a system of given NAME was registered already. -NAME is a system designator, to be normalized by COERCE-NAME. -The value returned if true is a pair of a timestamp and a system object." - (gethash (coerce-name name) *defined-systems*)) + (defvar *registered-systems* (make-hash-table :test 'equal) + "This is a hash table whose keys are strings -- the names of systems -- +and whose values are systems. +A system is referred to as \"registered\" if it is present in this table.") (defun registered-system (name) "Return a system of given NAME that was registered already, if such a system exists. NAME is a system designator, to be normalized by COERCE-NAME. The value returned is a system object, or NIL if not found." - (cdr (system-registered-p name))) + (gethash (coerce-name name) *registered-systems*)) (defun registered-systems* () "Return a list containing every registered system (as a system object)." - (loop :for registered :being :the :hash-values :of *defined-systems* - :collect (cdr registered))) + (loop :for registered :being :the :hash-values :of *registered-systems* + :collect registered)) (defun registered-systems () "Return a list of the names of every registered system." @@ -8273,19 +8450,16 @@ or NIL if not found." (check-type system system) (let ((name (component-name system))) (check-type name string) - (asdf-message (compatfmt "~&~@<; ~@;Registering ~3i~_~A~@:>~%") system) - (unless (eq system (registered-system name)) - (setf (gethash name *defined-systems*) - (cons (ignore-errors (get-file-stamp (system-source-file system))) - system))))) + (asdf-message (compatfmt "~&~@<; ~@;Registering system ~3i~_~A~@:>~%") name) + (setf (gethash name *registered-systems*) system))) (defun map-systems (fn) "Apply FN to each defined system. FN should be a function of one argument. It will be called with an object of type asdf:system." - (loop :for registered :being :the :hash-values :of *defined-systems* - :do (funcall fn (cdr registered)))) + (loop :for registered :being :the :hash-values :of *registered-systems* + :do (funcall fn registered))) ;;; Preloaded systems: in the image even if you can't find source files backing them. @@ -8293,7 +8467,7 @@ called with an object of type asdf:system." (defvar *preloaded-systems* (make-hash-table :test 'equal) "Registration table for preloaded systems.") - (declaim (ftype (function (t) t) mark-component-preloaded)) ; defined in asdf/operate + (declaim (ftype (function (t) t) mark-component-preloaded)) ; defined in asdf/find-system (defun make-preloaded-system (name keys) "Make a preloaded system of given NAME with build information from KEYS" @@ -8379,15 +8553,14 @@ Returns T if system was or is now undefined, NIL if a new preloaded system was r ;; a general such operation cannot be portably written, ;; considering how much CL relies on side-effects to global data structures. (let ((name (coerce-name system))) - (remhash name *defined-systems*) + (remhash name *registered-systems*) (unset-asdf-cache-entry `(find-system ,name)) (not (ensure-preloaded-system-registered name)))) - (defun clear-defined-systems () + (defun clear-registered-systems () "Clear all currently registered defined systems. Preloaded systems (including immutable ones) will be reset, other systems will be de-registered." - (loop :for name :being :the :hash-keys :of *defined-systems* - :unless (member name '("asdf" "uiop") :test 'equal) :do (clear-system name))) + (map () 'clear-system (registered-systems))) ;;; Searching for system definitions @@ -8424,7 +8597,7 @@ with that name.") ;; it is to be called by locate-system. (defun search-for-system-definition (system) ;; Search for valid definitions of the system available in the current session. - ;; Previous definitions as registered in *defined-systems* MUST NOT be considered; + ;; Previous definitions as registered in *registered-systems* MUST NOT be considered; ;; they will be reconciled by locate-system then find-system. ;; There are two special treatments: first, specially search for objects being defined ;; in the current session, to avoid definition races between several files; @@ -8527,461 +8700,65 @@ Going forward, we recommend new users should be using the source-registry.") (setf *central-registry* (append (subseq *central-registry* 0 position) (list new) - (subseq *central-registry* (1+ position)))))))))) - - - ;;; Methods for find-system + (subseq *central-registry* (1+ position))))))))))) - ;; Reject NIL as a system designator. - (defmethod find-system ((name null) &optional (error-p t)) - (when error-p - (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>")))) +;;;; ------------------------------------------------------------------------- +;;;; Actions - ;; Default method for find-system: resolve the argument using COERCE-NAME. - (defmethod find-system (name &optional (error-p t)) - (find-system (coerce-name name) error-p)) +(uiop/package:define-package :asdf/action + (:nicknames :asdf-action) + (:recycle :asdf/action :asdf/plan :asdf) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session :asdf/component :asdf/operation) + (:import-from :asdf/operation #:check-operation-constructor) + (:import-from :asdf/component #:%additional-input-files) + (:export + #:action #:define-convenience-action-methods + #:action-description #:format-action + #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation + #:non-propagating-operation + #:component-depends-on + #:input-files #:output-files #:output-file #:operation-done-p + #:action-operation #:action-component #:make-action + #:component-operation-time #:mark-operation-done #:compute-action-stamp + #:perform #:perform-with-restarts #:retry #:accept + #:action-path #:find-action + #:operation-definition-warning #:operation-definition-error ;; condition + #:action-valid-p + #:circular-dependency #:circular-dependency-actions + #:call-while-visiting-action #:while-visiting-action + #:additional-input-files)) +(in-package :asdf/action) - (defun find-system-if-being-defined (name) - ;; This function finds systems being defined *in the current ASDF session*, as embodied by - ;; its session cache, even before they are fully defined and registered in *defined-systems*. - ;; The purpose of this function is to prevent races between two files that might otherwise - ;; try overwrite each other's system objects, resulting in infinite loops and stack overflow. - ;; This function explicitly MUST NOT find definitions merely registered in previous sessions. - ;; NB: this function depends on a corresponding side-effect in parse-defsystem; - ;; the precise protocol between the two functions may change in the future (or not). - (first (gethash `(find-system ,(coerce-name name)) *asdf-cache*))) +(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) ;; LispWorks issues spurious warning - (defun load-asd (pathname - &key name (external-format (encoding-external-format (detect-encoding pathname))) - &aux (readtable *readtable*) (print-pprint-dispatch *print-pprint-dispatch*)) - "Load system definitions from PATHNAME. -NAME if supplied is the name of a system expected to be defined in that file. + (deftype action () + "A pair of operation and component uniquely identifies a node in the dependency graph +of steps to be performed while building a system." + '(cons operation component)) -Do NOT try to load a .asd file directly with CL:LOAD. Always use ASDF:LOAD-ASD." - (with-asdf-cache () - (with-standard-io-syntax - (let ((*package* (find-package :asdf-user)) - ;; Note that our backward-compatible *readtable* is - ;; a global readtable that gets globally side-effected. Ouch. - ;; Same for the *print-pprint-dispatch* table. - ;; We should do something about that for ASDF3 if possible, or else ASDF4. - (*readtable* readtable) - (*print-pprint-dispatch* print-pprint-dispatch) - (*print-readably* nil) - (*default-pathname-defaults* - ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings. - (pathname-directory-pathname (physicalize-pathname pathname)))) - (handler-bind - (((and error (not missing-component)) - #'(lambda (condition) - (error 'load-system-definition-error - :name name :pathname pathname :condition condition)))) - (asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%") - name pathname) - (load* pathname :external-format external-format)))))) + (deftype operation-designator () + "An operation designates itself. NIL designates a context-dependent current operation, +and a class-name or class designates the canonical instance of the designated class." + '(or operation null symbol class))) - (defvar *old-asdf-systems* (make-hash-table :test 'equal)) - - ;; (Private) function to check that a system that was found isn't an asdf downgrade. - ;; Returns T if everything went right, NIL if the system was an ASDF of the same or older version, - ;; that shall not be loaded. Also issue a warning if it was a strictly older version of ASDF. - (defun check-not-old-asdf-system (name pathname) - (or (not (equal name "asdf")) - (null pathname) - (let* ((version-pathname (subpathname pathname "version.lisp-expr")) - (version (and (probe-file* version-pathname :truename nil) - (read-file-form version-pathname))) - (old-version (asdf-version))) - (cond - ((version< old-version version) t) ;; newer version: good! - ((equal old-version version) nil) ;; same version: don't load, but don't warn - (t ;; old version: bad - (ensure-gethash - (list (namestring pathname) version) *old-asdf-systems* - #'(lambda () - (let ((old-pathname (system-source-file (registered-system "asdf")))) - (warn "~@<~ - You are using ASDF version ~A ~:[(probably from (require \"asdf\") ~ - or loaded by quicklisp)~;from ~:*~S~] and have an older version of ASDF ~ - ~:[(and older than 2.27 at that)~;~:*~A~] registered at ~S. ~ - Having an ASDF installed and registered is the normal way of configuring ASDF to upgrade itself, ~ - and having an old version registered is a configuration error. ~ - ASDF will ignore this configured system rather than downgrade itself. ~ - In the future, you may want to either: ~ - (a) upgrade this configured ASDF to a newer version, ~ - (b) install a newer ASDF and register it in front of the former in your configuration, or ~ - (c) uninstall or unregister this and any other old version of ASDF from your configuration. ~ - Note that the older ASDF might be registered implicitly through configuration inherited ~ - from your system installation, in which case you might have to specify ~ - :ignore-inherited-configuration in your in your ~~/.config/common-lisp/source-registry.conf ~ - or other source-registry configuration file, environment variable or lisp parameter. ~ - Indeed, a likely offender is an obsolete version of the cl-asdf debian or ubuntu package, ~ - that you might want to upgrade (if a recent enough version is available) ~ - or else remove altogether (since most implementations ship with a recent asdf); ~ - if you lack the system administration rights to upgrade or remove this package, ~ - then you might indeed want to either install and register a more recent version, ~ - or use :ignore-inherited-configuration to avoid registering the old one. ~ - Please consult ASDF documentation and/or experts.~@:>~%" - old-version old-pathname version pathname)))) - nil))))) ;; only issue the warning the first time, but always return nil - - (defun locate-system (name) - "Given a system NAME designator, try to locate where to load the system from. -Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME -FOUNDP is true when a system was found, -either a new unregistered one or a previously registered one. -FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed. -PATHNAME when not null is a path from which to load the system, -either associated with FOUND-SYSTEM, or with the PREVIOUS system. -PREVIOUS when not null is a previously loaded SYSTEM object of same name. -PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded." - (with-asdf-cache () ;; NB: We don't cache the results. We once used to, but it wasn't useful, - ;; and keeping a negative cache was a bug (see lp#1335323), which required - ;; explicit invalidation in clear-system and find-system (when unsucccessful). - (let* ((name (coerce-name name)) - (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk - (previous (cdr in-memory)) - (previous (and (typep previous 'system) previous)) - (previous-time (car in-memory)) - (found (search-for-system-definition name)) - (found-system (and (typep found 'system) found)) - (pathname (ensure-pathname - (or (and (typep found '(or pathname string)) (pathname found)) - (system-source-file found-system) - (system-source-file previous)) - :want-absolute t :resolve-symlinks *resolve-symlinks*)) - (foundp (and (or found-system pathname previous) t))) - (check-type found (or null pathname system)) - (unless (check-not-old-asdf-system name pathname) - (check-type previous system) ;; asdf is preloaded, so there should be a previous one. - (setf found-system nil pathname nil)) - (values foundp found-system pathname previous previous-time)))) - - ;; Main method for find-system: first, make sure the computation is memoized in a session cache. - ;; unless the system is immutable, use locate-system to find the primary system; - ;; reconcile the finding (if any) with any previous definition (in a previous session, - ;; preloaded, with a previous configuration, or before filesystem changes), and - ;; load a found .asd if appropriate. Finally, update registration table and return results. - (defmethod find-system ((name string) &optional (error-p t)) - (with-asdf-cache (:key `(find-system ,name)) - (let ((primary-name (primary-system-name name))) - (unless (equal name primary-name) - (find-system primary-name nil))) - (or (and *immutable-systems* (gethash name *immutable-systems*) (registered-system name)) - (multiple-value-bind (foundp found-system pathname previous previous-time) - (locate-system name) - (assert (eq foundp (and (or found-system pathname previous) t))) - (let ((previous-pathname (system-source-file previous)) - (system (or previous found-system))) - (when (and found-system (not previous)) - (register-system found-system)) - (when (and system pathname) - (setf (system-source-file system) pathname)) - (when (and pathname - (let ((stamp (get-file-stamp pathname))) - (and stamp - (not (and previous - (or (pathname-equal pathname previous-pathname) - (and pathname previous-pathname - (pathname-equal - (physicalize-pathname pathname) - (physicalize-pathname previous-pathname)))) - (stamp<= stamp previous-time)))))) - ;; Only load when it's a pathname that is different or has newer content. - (load-asd pathname :name name))) - ;; Try again after having loaded from disk if needed - (let ((in-memory (system-registered-p name))) - (cond - (in-memory - (when pathname - (setf (car in-memory) (get-file-stamp pathname))) - (cdr in-memory)) - (error-p - (error 'missing-component :requires name)) - (t - (return-from find-system nil))))))))) -;;;; ------------------------------------------------------------------------- -;;;; Finding components - -(uiop/package:define-package :asdf/find-component - (:recycle :asdf/find-component :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache - :asdf/component :asdf/system :asdf/find-system) - (:export - #:find-component - #:resolve-dependency-name #:resolve-dependency-spec - #:resolve-dependency-combination - ;; Conditions - #:missing-component #:missing-component-of-version #:retry - #:missing-dependency #:missing-dependency-of-version - #:missing-requires #:missing-parent - #:missing-required-by #:missing-version)) -(in-package :asdf/find-component) - -;;;; Missing component conditions - -(with-upgradability () - (define-condition missing-component-of-version (missing-component) - ((version :initform nil :reader missing-version :initarg :version))) - - (define-condition missing-dependency (missing-component) - ((required-by :initarg :required-by :reader missing-required-by))) - - (defmethod print-object ((c missing-dependency) s) - (format s (compatfmt "~@<~A, required by ~A~@:>") - (call-next-method c nil) (missing-required-by c))) - - (define-condition missing-dependency-of-version (missing-dependency - missing-component-of-version) - ()) - - (defmethod print-object ((c missing-component) s) - (format s (compatfmt "~@<Component ~S not found~@[ in ~A~]~@:>") - (missing-requires c) - (when (missing-parent c) - (coerce-name (missing-parent c))))) - - (defmethod print-object ((c missing-component-of-version) s) - (format s (compatfmt "~@<Component ~S does not match version ~A~@[ in ~A~]~@:>") - (missing-requires c) - (missing-version c) - (when (missing-parent c) - (coerce-name (missing-parent c)))))) - - -;;;; Finding components - -(with-upgradability () - (defgeneric find-component (base path &key registered) - (:documentation "Find a component by resolving the PATH starting from BASE parent. -If REGISTERED is true, only search currently registered systems.")) - (defgeneric resolve-dependency-combination (component combinator arguments) - (:documentation "Return a component satisfying the dependency specification (COMBINATOR . ARGUMENTS) -in the context of COMPONENT")) - - ;; Methods for find-component - - ;; If the base component is a string, resolve it as a system, then if not nil follow the path. - (defmethod find-component ((base string) path &key registered) - (if-let ((s (if registered - (registered-system base) - (find-system base nil)))) - (find-component s path :registered registered))) - - ;; If the base component is a symbol, coerce it to a name if not nil, and resolve that. - ;; If nil, use the path as base if not nil, or else return nil. - (defmethod find-component ((base symbol) path &key registered) - (cond - (base (find-component (coerce-name base) path :registered registered)) - (path (find-component path nil :registered registered)) - (t nil))) - - ;; If the base component is a cons cell, resolve its car, and add its cdr to the path. - (defmethod find-component ((base cons) path &key registered) - (find-component (car base) (cons (cdr base) path) :registered registered)) - - ;; If the base component is a parent-component and the path a string, find the named child. - (defmethod find-component ((parent parent-component) (name string) &key registered) - (declare (ignorable registered)) - (compute-children-by-name parent :only-if-needed-p t) - (values (gethash name (component-children-by-name parent)))) - - ;; If the path is a symbol, coerce it to a name if non-nil, or else just return the base. - (defmethod find-component (base (name symbol) &key registered) - (if name - (find-component base (coerce-name name) :registered registered) - base)) - - ;; If the path is a cons, first resolve its car as path, then its cdr. - (defmethod find-component ((c component) (name cons) &key registered) - (find-component (find-component c (car name) :registered registered) - (cdr name) :registered registered)) - - ;; If the path is a component, return it, disregarding the base. - (defmethod find-component ((base t) (actual component) &key registered) - (declare (ignorable registered)) - actual) - - ;; Resolve dependency NAME in the context of a COMPONENT, with given optional VERSION constraint. - ;; This (private) function is used below by RESOLVE-DEPENDENCY-SPEC and by the :VERSION spec. - (defun resolve-dependency-name (component name &optional version) - (loop - (restart-case - (return - (let ((comp (find-component (component-parent component) name))) - (unless comp - (error 'missing-dependency - :required-by component - :requires name)) - (when version - (unless (version-satisfies comp version) - (error 'missing-dependency-of-version - :required-by component - :version version - :requires name))) - comp)) - (retry () - :report (lambda (s) - (format s (compatfmt "~@<Retry loading ~3i~_~A.~@:>") name)) - :test - (lambda (c) - (or (null c) - (and (typep c 'missing-dependency) - (eq (missing-required-by c) component) - (equal (missing-requires c) name)))) - (unless (component-parent component) - (let ((name (coerce-name name))) - (unset-asdf-cache-entry `(find-system ,name)))))))) - - ;; Resolve dependency specification DEP-SPEC in the context of COMPONENT. - ;; This is notably used by MAP-DIRECT-DEPENDENCIES to process the results of COMPONENT-DEPENDS-ON - ;; and by PARSE-DEFSYSTEM to process DEFSYSTEM-DEPENDS-ON. - (defun resolve-dependency-spec (component dep-spec) - (let ((component (find-component () component))) - (if (atom dep-spec) - (resolve-dependency-name component dep-spec) - (resolve-dependency-combination component (car dep-spec) (cdr dep-spec))))) - - ;; Methods for RESOLVE-DEPENDENCY-COMBINATION to parse lists as dependency specifications. - (defmethod resolve-dependency-combination (component combinator arguments) - (parameter-error (compatfmt "~@<In ~S, bad dependency ~S for ~S~@:>") - 'resolve-dependency-combination (cons combinator arguments) component)) - - (defmethod resolve-dependency-combination (component (combinator (eql :feature)) arguments) - (when (featurep (first arguments)) - (resolve-dependency-spec component (second arguments)))) - - (defmethod resolve-dependency-combination (component (combinator (eql :version)) arguments) - (resolve-dependency-name component (first arguments) (second arguments)))) ;; See lp#527788 - -;;;; ------------------------------------------------------------------------- -;;;; Operations - -(uiop/package:define-package :asdf/operation - (:recycle :asdf/operation :asdf/action :asdf) ;; asdf/action for FEATURE pre 2.31.5. - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system) - (:export - #:operation - #:*operations* #:make-operation #:find-operation - #:feature)) ;; TODO: stop exporting the deprecated FEATURE feature. -(in-package :asdf/operation) - -;;; Operation Classes -(when-upgrading (:version "2.27" :when (find-class 'operation nil)) - ;; override any obsolete shared-initialize method when upgrading from ASDF2. - (defmethod shared-initialize :after ((o operation) (slot-names t) &key) - (values))) - -(with-upgradability () - (defclass operation () - () - (:documentation "The base class for all ASDF operations. - -ASDF does NOT and never did distinguish between multiple operations of the same class. -Therefore, all slots of all operations MUST have :allocation :class and no initargs. No exceptions. -")) - - (defvar *in-make-operation* nil) - - (defun check-operation-constructor () - "Enforce that OPERATION instances must be created with MAKE-OPERATION." - (unless *in-make-operation* - (sysdef-error "OPERATION instances must only be created through MAKE-OPERATION."))) - - (defmethod print-object ((o operation) stream) - (print-unreadable-object (o stream :type t :identity nil))) - - ;;; Override previous methods (from 3.1.7 and earlier) and add proper error checking. - (defmethod initialize-instance :after ((o operation) &rest initargs &key &allow-other-keys) - (unless (null initargs) - (parameter-error "~S does not accept initargs" 'operation)))) - - -;;; make-operation, find-operation - -(with-upgradability () - ;; A table to memoize instances of a given operation. There shall be only one. - (defparameter* *operations* (make-hash-table :test 'equal)) - - ;; A memoizing way of creating instances of operation. - (defun make-operation (operation-class) - "This function creates and memoizes an instance of OPERATION-CLASS. -All operation instances MUST be created through this function. - -Use of INITARGS is not supported at this time." - (let ((class (coerce-class operation-class - :package :asdf/interface :super 'operation :error 'sysdef-error)) - (*in-make-operation* t)) - (ensure-gethash class *operations* `(make-instance ,class)))) - - ;; This function is mostly for backward and forward compatibility: - ;; operations used to preserve the operation-original-initargs of the context, - ;; and may in the future preserve some operation-canonical-initargs. - ;; Still, the treatment of NIL as a disabling context is useful in some cases. - (defgeneric find-operation (context spec) - (:documentation "Find an operation by resolving the SPEC in the CONTEXT")) - (defmethod find-operation ((context t) (spec operation)) - spec) - (defmethod find-operation ((context t) (spec symbol)) - (when spec ;; NIL designates itself, i.e. absence of operation - (make-operation spec))) ;; TODO: preserve the (operation-canonical-initargs context) - (defmethod find-operation ((context t) (spec string)) - (make-operation spec))) ;; TODO: preserve the (operation-canonical-initargs context) - -;;;; ------------------------------------------------------------------------- -;;;; Actions - -(uiop/package:define-package :asdf/action - (:nicknames :asdf-action) - (:recycle :asdf/action :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade - :asdf/component :asdf/system #:asdf/cache :asdf/find-system :asdf/find-component :asdf/operation) - (:import-from :asdf/operation #:check-operation-constructor) - #-clisp (:unintern #:required-components #:traverse-action #:traverse-sub-actions) - (:export - #:action #:define-convenience-action-methods - #:action-description - #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation #:non-propagating-operation - #:component-depends-on - #:input-files #:output-files #:output-file #:operation-done-p - #:action-status #:action-stamp #:action-done-p - #:action-operation #:action-component #:make-action - #:component-operation-time #:mark-operation-done #:compute-action-stamp - #:perform #:perform-with-restarts #:retry #:accept - #:action-path #:find-action #:stamp #:done-p - #:operation-definition-warning #:operation-definition-error ;; condition - )) -(in-package :asdf/action) - -(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) ;; LispWorks issues spurious warning - - (deftype action () - "A pair of operation and component uniquely identifies a node in the dependency graph -of steps to be performed while building a system." - '(cons operation component)) - - (deftype operation-designator () - "An operation designates itself. NIL designates a context-dependent current operation, -and a class-name or class designates the canonical instance of the designated class." - '(or operation null symbol class))) - -;;; these are pseudo accessors -- let us abstract away the CONS cell representation of plan -;;; actions. -(with-upgradability () - (defun make-action (operation component) - (cons operation component)) - (defun action-operation (action) - (car action)) - (defun action-component (action) - (cdr action))) +;;; these are pseudo accessors -- let us abstract away the CONS cell representation of plan +;;; actions. +(with-upgradability () + (defun make-action (operation component) + (cons operation component)) + (defun action-operation (action) + (car action)) + (defun action-component (action) + (cdr action))) ;;;; Reified representation for storage or debugging. Note: an action is identified by its class. (with-upgradability () (defun action-path (action) "A readable data structure that identifies the action." - (let ((o (action-operation action)) - (c (action-component action))) - (cons (type-of o) (component-find-path c)))) + (when action + (let ((o (action-operation action)) + (c (action-component action))) + (cons (type-of o) (component-find-path c))))) (defun find-action (path) "Reconstitute an action from its action-path" (destructuring-bind (o . c) path (make-action (make-operation o) (find-component () c))))) @@ -9039,7 +8816,7 @@ and a class-name or class designates the canonical instance of the designated cl ,if-no-component)))))))) -;;;; self-description +;;;; Self-description (with-upgradability () (defgeneric action-description (operation component) (:documentation "returns a phrase that describes performing this operation @@ -9057,6 +8834,42 @@ Use it in FORMAT control strings as ~/asdf-action:format-action/" (princ (action-description operation component) stream)))) +;;;; Detection of circular dependencies +(with-upgradability () + (defun (action-valid-p) (operation component) + "Is this action valid to include amongst dependencies?" + ;; If either the operation or component was resolved to nil, the action is invalid. + ;; :if-feature will invalidate actions on components for which the features don't apply. + (and operation component + (if-let (it (component-if-feature component)) (featurep it) t))) + + (define-condition circular-dependency (system-definition-error) + ((actions :initarg :actions :reader circular-dependency-actions)) + (:report (lambda (c s) + (format s (compatfmt "~@<Circular dependency: ~3i~_~S~@:>") + (circular-dependency-actions c))))) + + (defun call-while-visiting-action (operation component fun) + "Detect circular dependencies" + (with-asdf-session () + (with-accessors ((action-set visiting-action-set) + (action-list visiting-action-list)) *asdf-session* + (let ((action (cons operation component))) + (when (gethash action action-set) + (error 'circular-dependency :actions + (member action (reverse action-list) :test 'equal))) + (setf (gethash action action-set) t) + (push action action-list) + (unwind-protect + (funcall fun) + (pop action-list) + (setf (gethash action action-set) nil)))))) + + ;; Syntactic sugar for call-while-visiting-action + (defmacro while-visiting-action ((o c) &body body) + `(call-while-visiting-action ,o ,c #'(lambda () ,@body)))) + + ;;;; Dependencies (with-upgradability () (defgeneric component-depends-on (operation component) ;; ASDF4: rename to component-dependencies @@ -9199,7 +9012,7 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m don't. In the future this functionality will be removed, and the default will be no propagation." (uiop/version::notify-deprecated-function (version-deprecation *asdf-version* :style-warning "3.2") - 'backward-compatible-depends-on) + `(backward-compatible-depends-on :for-operation ,o)) `(,@(sideway-operation-depends-on o c) ,@(when (typep c 'parent-component) (downward-operation-depends-on o c)))) @@ -9271,10 +9084,24 @@ They may rely on the order of the files to discriminate between inputs. (assert (length=n-p files 1)) (first files))) + (defgeneric additional-input-files (operation component) + (:documentation "Additional input files for the operation on this + component. These are files that are inferred, rather than + explicitly specified, and these are typically NOT files that + undergo operations directly. Instead, they are files that it is + important for ASDF to know about in order to compute operation times,etc.")) + (define-convenience-action-methods additional-input-files (operation component)) + (defmethod additional-input-files ((op operation) (comp component)) + (cdr (assoc op (%additional-input-files comp)))) + ;; Memoize input files. (defmethod input-files :around (operation component) (do-asdf-cache `(input-files ,operation ,component) - (call-next-method))) + ;; get the additional input files, if any + (append (call-next-method) + ;; must come after the first, for other code that + ;; assumes the first will be the "key" file + (additional-input-files operation component)))) ;; By default an action has no input-files. (defmethod input-files ((o operation) (c component)) @@ -9307,7 +9134,8 @@ They may rely on the order of the files to discriminate between inputs. Updates the action's COMPONENT-OPERATION-TIME to match the COMPUTE-ACTION-STAMP using the JUST-DONE flag.")) - (defgeneric compute-action-stamp (plan operation component &key just-done) + (defgeneric compute-action-stamp (plan- operation component &key just-done) + ;; NB: using plan- rather than plan above allows clisp to upgrade from 2.26(!) (:documentation "Has this action been successfully done already, and at what known timestamp has it been done at or will it be done at? * PLAN is a plan object modelling future effects of actions, @@ -9323,29 +9151,17 @@ Returns two values: * a boolean DONE-P that indicates whether the action has actually been done, and both its output-files and its in-image side-effects are up to date.")) - (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.") - (done-p - :initarg :done-p :reader action-done-p - :documentation "a boolean, true iff the action was already done (before any planned action).")) - (:documentation "Status of an action")) - - (defmethod print-object ((status action-status) stream) - (print-unreadable-object (status stream :type t) - (with-slots (stamp done-p) status - (format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p)))) - (defmethod component-operation-time ((o operation) (c component)) (gethash o (component-operation-times c))) (defmethod (setf component-operation-time) (stamp (o operation) (c component)) + (assert stamp () "invalid null stamp for ~A" (action-description o c)) (setf (gethash o (component-operation-times c)) stamp)) (defmethod mark-operation-done ((o operation) (c component)) - (setf (component-operation-time o c) (compute-action-stamp nil o c :just-done t)))) + (let ((stamp (compute-action-stamp nil o c :just-done t))) + (assert stamp () "Failed to compute a stamp for completed action ~A" (action-description o c))1 + (setf (component-operation-time o c) stamp)))) ;;;; Perform @@ -9354,6 +9170,8 @@ in some previous image, or T if it needs to be done.") (:documentation "PERFORM an action, consuming its input-files and building its output-files")) (define-convenience-action-methods perform (operation component)) + (defmethod perform :around ((o operation) (c component)) + (while-visiting-action (o c) (call-next-method))) (defmethod perform :before ((o operation) (c component)) (ensure-all-directories-exist (output-files o c))) (defmethod perform :after ((o operation) (c component)) @@ -9396,9 +9214,8 @@ in some previous image, or T if it needs to be done.") (uiop/package:define-package :asdf/lisp-action (:recycle :asdf/lisp-action :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache - :asdf/component :asdf/system :asdf/find-component :asdf/find-system - :asdf/operation :asdf/action) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session + :asdf/component :asdf/system :asdf/operation :asdf/action) (:export #:try-recompiling #:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp @@ -9567,7 +9384,7 @@ an OPERATION and a COMPONENT." (defmethod input-files ((o compile-op) (c system)) (when (and *warnings-file-type* (not (builtin-system-p c))) ;; The most correct way to do it would be to use: - ;; (traverse-sub-actions o c :other-systems nil :keep-operation 'compile-op :keep-component 'cl-source-file) + ;; (collect-dependencies o c :other-systems nil :keep-operation 'compile-op :keep-component 'cl-source-file) ;; but it's expensive and we don't care too much about file order or ASDF extensions. (loop :for sub :in (sub-components c :type 'cl-source-file) :nconc (remove-if-not 'warnings-file-p (output-files o sub))))) @@ -9642,113 +9459,190 @@ an OPERATION and a COMPONENT." "Testing a system is _never_ done." nil)) ;;;; ------------------------------------------------------------------------- -;;;; Plan +;;;; Finding components + +(uiop/package:define-package :asdf/find-component + (:recycle :asdf/find-component :asdf/find-system :asdf) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session + :asdf/component :asdf/system :asdf/system-registry) + (:export + #:find-component + #:resolve-dependency-name #:resolve-dependency-spec + #:resolve-dependency-combination + ;; Conditions + #:missing-component #:missing-requires #:missing-parent #:missing-component-of-version #:retry + #:missing-dependency #:missing-dependency-of-version + #:missing-requires #:missing-parent + #:missing-required-by #:missing-version)) +(in-package :asdf/find-component) + +;;;; Missing component conditions + +(with-upgradability () + (define-condition missing-component (system-definition-error) + ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires) + (parent :initform nil :reader missing-parent :initarg :parent))) + + (define-condition missing-component-of-version (missing-component) + ((version :initform nil :reader missing-version :initarg :version))) + + (define-condition missing-dependency (missing-component) + ((required-by :initarg :required-by :reader missing-required-by))) + + (defmethod print-object ((c missing-dependency) s) + (format s (compatfmt "~@<~A, required by ~A~@:>") + (call-next-method c nil) (missing-required-by c))) + + (define-condition missing-dependency-of-version (missing-dependency + missing-component-of-version) + ()) + + (defmethod print-object ((c missing-component) s) + (format s (compatfmt "~@<Component ~S not found~@[ in ~A~]~@:>") + (missing-requires c) + (when (missing-parent c) + (coerce-name (missing-parent c))))) + + (defmethod print-object ((c missing-component-of-version) s) + (format s (compatfmt "~@<Component ~S does not match version ~A~@[ in ~A~]~@:>") + (missing-requires c) + (missing-version c) + (when (missing-parent c) + (coerce-name (missing-parent c)))))) + + +;;;; Finding components + +(with-upgradability () + (defgeneric resolve-dependency-combination (component combinator arguments) + (:documentation "Return a component satisfying the dependency specification (COMBINATOR . ARGUMENTS) +in the context of COMPONENT")) + + ;; Methods for find-component + + ;; If the base component is a string, resolve it as a system, then if not nil follow the path. + (defmethod find-component ((base string) path &key registered) + (if-let ((s (if registered + (registered-system base) + (find-system base nil)))) + (find-component s path :registered registered))) + + ;; If the base component is a symbol, coerce it to a name if not nil, and resolve that. + ;; If nil, use the path as base if not nil, or else return nil. + (defmethod find-component ((base symbol) path &key registered) + (cond + (base (find-component (coerce-name base) path :registered registered)) + (path (find-component path nil :registered registered)) + (t nil))) -(uiop/package:define-package :asdf/plan - ;; asdf/action below is needed for required-components, traverse-action and traverse-sub-actions - ;; that used to live there before 3.2.0. - (:recycle :asdf/plan :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade - :asdf/component :asdf/operation :asdf/system - :asdf/cache :asdf/find-system :asdf/find-component - :asdf/operation :asdf/action :asdf/lisp-action) - (:export - #:component-operation-time - #:plan #:plan-traversal #:sequential-plan #:*default-plan-class* - #:planned-action-status #:plan-action-status #:action-already-done-p - #:circular-dependency #:circular-dependency-actions - #:needed-in-image-p - #:action-index #:action-planned-p #:action-valid-p - #:plan-record-dependency - #:normalize-forced-systems #:action-forced-p #:action-forced-not-p - #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies - #: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 - #:planned-p #:index #:forced #:forced-not #:total-action-count - #:planned-action-count #:planned-output-action-count #:visited-actions - #:visiting-action-set #:visiting-action-list #:plan-actions-r - #:required-components #:filtered-sequential-plan - #:plan-system - #:plan-action-filter #:plan-component-type #:plan-keep-operation #:plan-keep-component - #:traverse-actions #:traverse-sub-actions)) -(in-package :asdf/plan) + ;; If the base component is a cons cell, resolve its car, and add its cdr to the path. + (defmethod find-component ((base cons) path &key registered) + (find-component (car base) (cons (cdr base) path) :registered registered)) -;;;; Generic plan traversal class -(with-upgradability () - (defclass plan () () - (:documentation "Base class for a plan based on which ASDF can build a system")) - (defclass plan-traversal (plan) - (;; The system for which the plan is computed - (system :initform nil :initarg :system :accessor plan-system) - ;; Table of systems specified via :force arguments - (forced :initform nil :initarg :force :accessor plan-forced) - ;; Table of systems specified via :force-not argument (and/or immutable) - (forced-not :initform nil :initarg :force-not :accessor plan-forced-not) - ;; Counts of total actions in plan - (total-action-count :initform 0 :accessor plan-total-action-count) - ;; Count of actions that need to be performed - (planned-action-count :initform 0 :accessor plan-planned-action-count) - ;; Count of actions that need to be performed that have a non-empty list of output-files. - (planned-output-action-count :initform 0 :accessor plan-planned-output-action-count) - ;; Table that to actions already visited while walking the dependencies associates status - (visited-actions :initform (make-hash-table :test 'equal) :accessor plan-visited-actions) - ;; Actions that depend on those being currently walked through, to detect circularities - (visiting-action-set ;; as a set - :initform (make-hash-table :test 'equal) :accessor plan-visiting-action-set) - (visiting-action-list :initform () :accessor plan-visiting-action-list)) ;; as a list - (:documentation "Base class for plans that simply traverse dependencies"))) + ;; If the base component is a parent-component and the path a string, find the named child. + (defmethod find-component ((parent parent-component) (name string) &key registered) + (declare (ignorable registered)) + (compute-children-by-name parent :only-if-needed-p t) + (values (gethash name (component-children-by-name parent)))) + ;; If the path is a symbol, coerce it to a name if non-nil, or else just return the base. + (defmethod find-component (base (name symbol) &key registered) + (if name + (find-component base (coerce-name name) :registered registered) + base)) -;;;; Planned action status -(with-upgradability () - (defgeneric plan-action-status (plan operation component) - (:documentation "Returns the ACTION-STATUS associated to -the action of OPERATION on COMPONENT in the PLAN")) + ;; If the path is a cons, first resolve its car as path, then its cdr. + (defmethod find-component ((c component) (name cons) &key registered) + (find-component (find-component c (car name) :registered registered) + (cdr name) :registered registered)) - (defgeneric (setf plan-action-status) (new-status plan operation component) - (:documentation "Sets the ACTION-STATUS associated to -the action of OPERATION on COMPONENT in the PLAN")) + ;; If the path is a component, return it, disregarding the base. + (defmethod find-component ((base t) (actual component) &key registered) + (declare (ignorable registered)) + actual) - (defclass planned-action-status (action-status) - ((planned-p - :initarg :planned-p :reader action-planned-p - :documentation "a boolean, true iff the action was included in the plan.") - (index - :initarg :index :reader action-index - :documentation "an integer, counting all traversed actions in traversal order.")) - (:documentation "Status of an action in a plan")) + ;; Resolve dependency NAME in the context of a COMPONENT, with given optional VERSION constraint. + ;; This (private) function is used below by RESOLVE-DEPENDENCY-SPEC and by the :VERSION spec. + (defun resolve-dependency-name (component name &optional version) + (loop + (restart-case + (return + (let ((comp (find-component (component-parent component) name))) + (unless comp + (error 'missing-dependency + :required-by component + :requires name)) + (when version + (unless (version-satisfies comp version) + (error 'missing-dependency-of-version + :required-by component + :version version + :requires name))) + comp)) + (retry () + :report (lambda (s) + (format s (compatfmt "~@<Retry loading ~3i~_~A.~@:>") name)) + :test + (lambda (c) + (or (null c) + (and (typep c 'missing-dependency) + (eq (missing-required-by c) component) + (equal (missing-requires c) name)))) + (unless (component-parent component) + (let ((name (coerce-name name))) + (unset-asdf-cache-entry `(find-system ,name)))))))) - (defmethod print-object ((status planned-action-status) stream) - (print-unreadable-object (status stream :type t :identity nil) - (with-slots (stamp done-p planned-p index) status - (format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p :planned-p planned-p :index index)))) + ;; Resolve dependency specification DEP-SPEC in the context of COMPONENT. + ;; This is notably used by MAP-DIRECT-DEPENDENCIES to process the results of COMPONENT-DEPENDS-ON + ;; and by PARSE-DEFSYSTEM to process DEFSYSTEM-DEPENDS-ON. + (defun resolve-dependency-spec (component dep-spec) + (let ((component (find-component () component))) + (if (atom dep-spec) + (resolve-dependency-name component dep-spec) + (resolve-dependency-combination component (car dep-spec) (cdr dep-spec))))) - (defmethod action-planned-p ((action-status t)) - t) ; default method for non planned-action-status objects + ;; Methods for RESOLVE-DEPENDENCY-COMBINATION to parse lists as dependency specifications. + (defmethod resolve-dependency-combination (component combinator arguments) + (parameter-error (compatfmt "~@<In ~S, bad dependency ~S for ~S~@:>") + 'resolve-dependency-combination (cons combinator arguments) component)) - (defun action-already-done-p (plan operation component) - "According to this plan, is this action already done and up to date?" - (action-done-p (plan-action-status plan operation component))) + (defmethod resolve-dependency-combination (component (combinator (eql :feature)) arguments) + (when (featurep (first arguments)) + (resolve-dependency-spec component (second arguments)))) - (defmethod plan-action-status ((plan null) (o operation) (c component)) - (multiple-value-bind (stamp done-p) (component-operation-time o c) - (make-instance 'action-status :stamp stamp :done-p done-p))) + (defmethod resolve-dependency-combination (component (combinator (eql :version)) arguments) + (resolve-dependency-name component (first arguments) (second arguments)))) ;; See lp#527788 - (defmethod (setf plan-action-status) (new-status (plan null) (o operation) (c component)) - (let ((times (component-operation-times c))) - (if (action-done-p new-status) - (remhash o times) - (setf (gethash o times) (action-stamp new-status)))) - new-status)) +;;;; ------------------------------------------------------------------------- +;;;; Forcing +(uiop/package:define-package :asdf/forcing + (:recycle :asdf/forcing :asdf/plan :asdf) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session + :asdf/component :asdf/operation :asdf/system :asdf/system-registry) + (:export + #:forcing #:make-forcing #:forced #:forced-not #:performable-p + #:normalize-forced-systems #:normalize-forced-not-systems + #:action-forced-p #:action-forced-not-p)) +(in-package :asdf/forcing) + +;;;; Forcing +(with-upgradability () + (defclass forcing () + (;; Can plans using this forcing be PERFORMed? A plan that has different force and force-not + ;; settings than the session can only be used for read-only queries that do not cause the + ;; status of any action to be raised. + (performable-p :initform nil :initarg :performable-p :reader performable-p) + ;; Parameters + (parameters :initform nil :initarg :parameters :reader parameters) + ;; Table of systems specified via :force arguments + (forced :initarg :forced :reader forced) + ;; Table of systems specified via :force-not argument (and/or immutable) + (forced-not :initarg :forced-not :reader forced-not))) -;;;; forcing -(with-upgradability () - (defgeneric action-forced-p (plan operation component) + (defgeneric action-forced-p (forcing operation component) (:documentation "Is this action forced to happen in this plan?")) - (defgeneric action-forced-not-p (plan operation component) + (defgeneric action-forced-not-p (forcing operation component) (:documentation "Is this action forced to not happen in this plan? Takes precedence over action-forced-p.")) @@ -9778,48 +9672,285 @@ or predicate on system names, or NIL if none are forced, or :ALL if all are." (or *immutable-systems* requested)))) ;; TODO: shouldn't we be looking up the primary system name, rather than the system name? - (defun action-override-p (plan operation component override-accessor) - "Given a plan, an action, and a function that given the plan accesses a set of overrides -(i.e. force or force-not), see if the override applies to the current action." + (defun action-override-p (forcing operation component override-accessor) + "Given a plan, an action, and a function that given the plan accesses a set of overrides, +i.e. force or force-not, see if the override applies to the current action." (declare (ignore operation)) - (call-function (funcall override-accessor plan) + (call-function (funcall override-accessor forcing) (coerce-name (component-system (find-component () component))))) - (defmethod action-forced-p (plan operation component) + (defmethod action-forced-p (forcing operation component) (and ;; Did the user ask us to re-perform the action? - (action-override-p plan operation component 'plan-forced) - ;; You really can't force a builtin system and :all doesn't apply to it, - ;; except if it's the specifically the system currently being built. - (not (let ((system (component-system component))) - (and (builtin-system-p system) - (not (eq system (plan-system plan)))))))) - - (defmethod action-forced-not-p (plan operation component) + (action-override-p forcing operation component 'forced) + ;; You really can't force a builtin system and :all doesn't apply to it. + (not (builtin-system-p (component-system component))))) + + (defmethod action-forced-not-p (forcing operation component) ;; Did the user ask us to not re-perform the action? ;; NB: force-not takes precedence over force, as it should - (action-override-p plan operation component 'plan-forced-not)) + (action-override-p forcing operation component 'forced-not)) - (defmethod action-forced-p ((plan null) (operation operation) (component component)) + ;; Null forcing means no forcing either way + (defmethod action-forced-p ((forcing null) (operation operation) (component component)) + nil) + (defmethod action-forced-not-p ((forcing null) (operation operation) (component component)) nil) - (defmethod action-forced-not-p ((plan null) (operation operation) (component component)) - nil)) + (defun or-function (fun1 fun2) + (cond + ((or (null fun2) (eq fun1 :all)) fun1) + ((or (null fun1) (eq fun2 :all)) fun2) + (t #'(lambda (x) (or (call-function fun1 x) (call-function fun2 x)))))) + + (defun make-forcing (&key performable-p system + (force nil force-p) (force-not nil force-not-p) &allow-other-keys) + (let* ((session-forcing (when *asdf-session* (forcing *asdf-session*))) + (system (and system (coerce-name system))) + (forced (normalize-forced-systems force system)) + (forced-not (normalize-forced-not-systems force-not system)) + (parameters `(,@(when force `(:force ,force)) + ,@(when force-not `(:force-not ,force-not)) + ,@(when (or (eq force t) (eq force-not t)) `(:system ,system)) + ,@(when performable-p `(:performable-p t)))) + forcing) + (cond + ((not session-forcing) + (setf forcing (make-instance 'forcing + :performable-p performable-p :parameters parameters + :forced forced :forced-not forced-not)) + (when (and performable-p *asdf-session*) + (setf (forcing *asdf-session*) forcing))) + (performable-p + (when (and (not (equal parameters (parameters session-forcing))) + (or force-p force-not-p)) + (parameter-error "~*~S and ~S arguments not allowed in a nested call to ~3:*~S ~ +unless identically to toplevel" + (find-symbol* :operate :asdf) :force :force-not)) + (setf forcing session-forcing)) + (t + (setf forcing (make-instance 'forcing + ;; Combine force and force-not with values from the toplevel-plan + :parameters `(,@parameters :on-top-of ,(parameters session-forcing)) + :forced (or-function (forced session-forcing) forced) + :forced-not (or-function (forced-not session-forcing) forced-not))))) + forcing)) + + (defmethod print-object ((forcing forcing) stream) + (print-unreadable-object (forcing stream :type t) + (format stream "~{~S~^ ~}" (parameters forcing)))) + + ;; During upgrade, the *asdf-session* may legitimately be NIL, so we must handle that case. + (defmethod forcing ((x null)) + (if-let (session (toplevel-asdf-session)) + (forcing session) + (make-forcing :performable-p t))) + + ;; When performing a plan that is a list of actions, use the toplevel asdf sesssion forcing. + (defmethod forcing ((x cons)) (forcing (toplevel-asdf-session)))) +;;;; ------------------------------------------------------------------------- +;;;; Plan + +(uiop/package:define-package :asdf/plan + ;; asdf/action below is needed for required-components, traverse-action and traverse-sub-actions + ;; that used to live there before 3.2.0. + (:recycle :asdf/plan :asdf/action :asdf) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session + :asdf/component :asdf/operation :asdf/action :asdf/lisp-action + :asdf/system :asdf/system-registry :asdf/find-component :asdf/forcing) + (:export + #:plan #:plan-traversal #:sequential-plan #:*plan-class* + #:action-status #:status-stamp #:status-index #:status-done-p #:status-keep-p #:status-need-p + #:action-already-done-p + #:+status-good+ #:+status-todo+ #:+status-void+ + #:system-out-of-date #:action-up-to-date-p + #:circular-dependency #:circular-dependency-actions + #:needed-in-image-p + #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies + #:compute-action-stamp #:traverse-action #:record-dependency + #:make-plan #:plan-actions #:plan-actions-r #:perform-plan #:mark-as-done + #:required-components #:filtered-sequential-plan + #:plan-component-type #:plan-keep-operation #:plan-keep-component)) +(in-package :asdf/plan) +;;;; Generic plan traversal class +(with-upgradability () + (defclass plan () () + (:documentation "Base class for a plan based on which ASDF can build a system")) + (defclass plan-traversal (plan) + (;; The forcing parameters for this plan. Also indicates whether the plan is performable, + ;; in which case the forcing is the same as for the entire session. + (forcing :initform (forcing (toplevel-asdf-session)) :initarg :forcing :reader forcing)) + (:documentation "Base class for plans that simply traverse dependencies")) + ;; Sequential plans (the default) + (defclass sequential-plan (plan-traversal) + ((actions-r :initform nil :accessor plan-actions-r)) + (:documentation "Simplest, default plan class, accumulating a sequence of actions")) + + (defgeneric plan-actions (plan) + (:documentation "Extract from a plan a list of actions to perform in sequence")) + (defmethod plan-actions ((plan list)) + plan) + (defmethod plan-actions ((plan sequential-plan)) + (reverse (plan-actions-r plan))) + + (defgeneric record-dependency (plan operation component) + (:documentation "Record an action as a dependency in the current plan")) -;;;; action-valid-p + ;; No need to record a dependency to build a full graph, just accumulate nodes in order. + (defmethod record-dependency ((plan sequential-plan) (o operation) (c component)) + (values))) + +(when-upgrading (:version "3.2.1") + (defmethod initialize-instance :after ((plan plan-traversal) &key &allow-other-keys))) + + +;;;; Planned action status (with-upgradability () - (defgeneric action-valid-p (plan operation component) - (:documentation "Is this action valid to include amongst dependencies?")) - ;; :if-feature will invalidate actions on components for which the features don't apply. - (defmethod action-valid-p ((plan t) (o operation) (c component)) - (if-let (it (component-if-feature c)) (featurep it) t)) - ;; If either the operation or component was resolved to nil, the action is invalid. - (defmethod action-valid-p ((plan t) (o null) (c t)) nil) - (defmethod action-valid-p ((plan t) (o t) (c null)) nil) - ;; If the plan is null, i.e., we're looking at reality, - ;; then any action with actual operation and component objects is valid. - (defmethod action-valid-p ((plan null) (o operation) (c component)) t)) + (defclass action-status () + ((bits + :type fixnum :initarg :bits :reader status-bits + :documentation "bitmap describing the status of the action.") + (stamp + :type (or integer boolean) :initarg :stamp :reader status-stamp + :documentation "STAMP associated with the ACTION if it has been completed already in some +previous session or image, T if it was done and builtin the image, or NIL if it needs to be done.") + (level + :type fixnum :initarg :level :initform 0 :reader status-level + :documentation "the highest (operate-level) at which the action was needed") + (index + :type (or integer null) :initarg :index :initform nil :reader status-index + :documentation "INDEX associated with the ACTION in the current session, +or NIL if no the status is considered outside of a specific plan.")) + (:documentation "Status of an action in a plan")) + + ;; STAMP KEEP-P DONE-P NEED-P symbol bitmap previously currently + ;; not-nil T T T => GOOD 7 up-to-date done (e.g. file previously loaded) + ;; not-nil T T NIL => HERE 6 up-to-date unplanned yet done + ;; not-nil T NIL T => REDO 5 up-to-date planned (e.g. file to load) + ;; not-nil T NIL NIL => SKIP 4 up-to-date unplanned (e.g. file compiled) + ;; not-nil NIL T T => DONE 3 out-of-date done + ;; not-nil NIL T NIL => WHAT 2 out-of-date unplanned yet done(?) + ;; NIL NIL NIL T => TODO 1 out-of-date planned + ;; NIL NIL NIL NIL => VOID 0 out-of-date unplanned + ;; + ;; Note that a VOID status cannot happen as part of a transitive dependency of a wanted node + ;; while traversing a node with TRAVERSE-ACTION; it can only happen while checking whether an + ;; action is up-to-date with ACTION-UP-TO-DATE-P. + ;; + ;; When calling TRAVERSE-ACTION, the +need-bit+ is set, + ;; unless the action is up-to-date and not needed-in-image (HERE, SKIP). + ;; When PERFORMing an action, the +done-bit+ is set. + ;; When the +need-bit+ is set but not the +done-bit+, the level slot indicates which level of + ;; OPERATE it was last marked needed for; if it happens to be needed at a higher-level, then + ;; its urgency (and that of its transitive dependencies) must be escalated so that it will be + ;; done before the end of this level of operate. + ;; + ;; Also, when no ACTION-STATUS is associated to an action yet, NIL serves as a bottom value. + ;; + (defparameter +keep-bit+ 4) + (defparameter +done-bit+ 2) + (defparameter +need-bit+ 1) + (defparameter +good-bits+ 7) + (defparameter +todo-bits+ 1) + (defparameter +void-bits+ 0) + + (defparameter +status-good+ + (make-instance 'action-status :bits +good-bits+ :stamp t)) + (defparameter +status-todo+ + (make-instance 'action-status :bits +todo-bits+ :stamp nil)) + (defparameter +status-void+ + (make-instance 'action-status :bits +void-bits+ :stamp nil))) + +(with-upgradability () + (defun make-action-status (&key bits stamp (level 0) index) + (check-type bits (integer 0 7)) + (check-type stamp (or integer boolean)) + (check-type level (integer 0 #.most-positive-fixnum)) + (check-type index (or integer null)) + (assert (eq (null stamp) (zerop (logand bits #.(logior +keep-bit+ +done-bit+)))) () + "Bad action-status :bits ~S :stamp ~S" bits stamp) + (block nil + (when (and (null index) (zerop level)) + (case bits + (#.+void-bits+ (return +status-void+)) + (#.+todo-bits+ (return +status-todo+)) + (#.+good-bits+ (when (eq stamp t) (return +status-good+))))) + (make-instance 'action-status :bits bits :stamp stamp :level level :index index))) + + (defun status-keep-p (status) + (plusp (logand (status-bits status) #.+keep-bit+))) + (defun status-done-p (status) + (plusp (logand (status-bits status) #.+done-bit+))) + (defun status-need-p (status) + (plusp (logand (status-bits status) #.+need-bit+))) + + (defun merge-action-status (status1 status2) ;; status-and + "Return the earliest status later than both status1 and status2" + (make-action-status + :bits (logand (status-bits status1) (status-bits status2)) + :stamp (latest-stamp (status-stamp status1) (status-stamp status2)) + :level (min (status-level status1) (status-level status2)) + :index (or (status-index status1) (status-index status2)))) + + (defun mark-status-needed (status &optional (level (operate-level))) ;; limited status-or + "Return the same status but with the need bit set, for the given level" + (if (and (status-need-p status) + (>= (status-level status) level)) + status + (make-action-status + :bits (logior (status-bits status) +need-bit+) + :level (max level (status-level status)) + :stamp (status-stamp status) + :index (status-index status)))) + + (defmethod print-object ((status action-status) stream) + (print-unreadable-object (status stream :type t) + (with-slots (bits stamp level index) status + (format stream "~{~S~^ ~}" `(:bits ,bits :stamp ,stamp :level ,level :index ,index))))) + + (defgeneric action-status (plan operation component) + (:documentation "Returns the ACTION-STATUS associated to the action of OPERATION on COMPONENT +in the PLAN, or NIL if the action wasn't visited yet as part of the PLAN.")) + + (defgeneric (setf action-status) (new-status plan operation component) + (:documentation "Sets the ACTION-STATUS associated to +the action of OPERATION on COMPONENT in the PLAN")) + + (defmethod action-status ((plan null) (o operation) (c component)) + (multiple-value-bind (stamp done-p) (component-operation-time o c) + (if done-p + (make-action-status :bits #.+keep-bit+ :stamp stamp) + +status-void+))) + + (defmethod (setf action-status) (new-status (plan null) (o operation) (c component)) + (let ((times (component-operation-times c))) + (if (status-done-p new-status) + (setf (gethash o times) (status-stamp new-status)) + (remhash o times))) + new-status) + + ;; Handle FORCED-NOT: it makes an action return its current timestamp as status + (defmethod action-status ((p plan) (o operation) (c component)) + ;; TODO: should we instead test something like: + ;; (action-forced-not-p plan operation (primary-system component)) + (or (gethash (make-action o c) (visited-actions *asdf-session*)) + (when (action-forced-not-p (forcing p) o c) + (let ((status (action-status nil o c))) + (setf (gethash (make-action o c) (visited-actions *asdf-session*)) + (make-action-status + :bits +good-bits+ + :stamp (or (and status (status-stamp status)) t) + :index (incf (total-action-count *asdf-session*)))))))) + + (defmethod (setf action-status) (new-status (p plan) (o operation) (c component)) + (setf (gethash (make-action o c) (visited-actions *asdf-session*)) new-status)) + + (defmethod (setf action-status) :after + (new-status (p sequential-plan) (o operation) (c component)) + (unless (status-done-p new-status) + (push (make-action o c) (plan-actions-r p))))) + ;;;; Is the action needed in this image? (with-upgradability () @@ -9837,29 +9968,28 @@ to be meaningful, or could it just as well have been done in another Lisp image? ;;;; Visiting dependencies of an action and computing action stamps (with-upgradability () - (defun* (map-direct-dependencies) (plan operation component fun) + (defun* (map-direct-dependencies) (operation component fun) "Call FUN on all the valid dependencies of the given action in the given plan" (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 (and dep-c (action-valid-p plan dep-o dep-c)) - :do (funcall fun dep-o dep-c)))) - - (defun* (reduce-direct-dependencies) (plan operation component combinator seed) + :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 (action-valid-p dep-o dep-c) + :do (funcall fun dep-o dep-c)))) + + (defun* (reduce-direct-dependencies) (operation component combinator seed) "Reduce the direct dependencies to a value computed by iteratively calling COMBINATOR for each dependency action on the dependency's operation and component and an accumulator initialized with SEED." (map-direct-dependencies - plan operation component - #'(lambda (dep-o dep-c) - (setf seed (funcall combinator dep-o dep-c seed)))) + operation component + #'(lambda (dep-o dep-c) (setf seed (funcall combinator dep-o dep-c seed)))) seed) - (defun* (direct-dependencies) (plan operation component) + (defun* (direct-dependencies) (operation component) "Compute a list of the direct dependencies of the action within the plan" - (reverse (reduce-direct-dependencies plan operation component #'acons nil))) + (reverse (reduce-direct-dependencies 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, @@ -9872,256 +10002,205 @@ initialized with SEED." ;; or if it has just been done, return the time that it has. ;; Returns two values: ;; 1- the TIMESTAMP of the action if it has already been done and is up to date, - ;; or T is either hasn't been done or is out of date. + ;; or NIL is either hasn't been done or is out of date. + ;; (An ASDF extension could use a cryptographic digest instead.) ;; 2- the DONE-IN-IMAGE-P boolean flag that is T if the action has already been done ;; in the current image, or NIL if it hasn't. ;; 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, + ;; hasn't been done in the current image yet, then it can have a non-NIL timestamp, ;; yet a NIL done-in-image-p flag: we can predict what timestamp it will have once loaded, ;; i.e. that of the input-files. + ;; If just-done is NIL, these values return are the notional fields of + ;; a KEEP, REDO or TODO status (VOID is possible, but probably an error). + ;; If just-done is T, they are the notional fields of DONE status + ;; (or, if something went wrong, TODO). (nest (block ()) - (let ((dep-stamp ; collect timestamp from dependencies (or T if forced or out-of-date) + (let* ((dep-status ; 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)) + o c + #'(lambda (do dc status) + ;; out-of-date dependency: don't bother looking further + (let ((action-status (action-status plan do dc))) + (cond + ((and action-status (or (status-keep-p action-status) + (and just-done (status-stamp action-status)))) + (merge-action-status action-status status)) + (just-done + ;; It's OK to lose some ASDF action stamps during self-upgrade + (unless (equal "asdf" (primary-system-name dc)) + (warn "Computing just-done stamp in plan ~S for action ~S, but dependency ~S wasn't done yet!" + plan + (action-path (make-action o c)) + (action-path (make-action do dc)))) + status) + (t + (return (values nil nil)))))) + +status-good+)) + (dep-stamp (status-stamp dep-status)))) + (let* (;; collect timestamps from inputs, and exit early if any is missing + (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 (remove-if 'null (output-files o c))) + (when (and missing-in (not just-done)) (return (values nil nil)))) + (let* (;; collect timestamps from outputs, and exit early if any is missing + (out-files (remove-if 'null (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)))) + (when (and missing-out (not just-done)) (return (values nil nil)))) + (let (;; 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? + ;; Note that we use stamp<= instead of stamp< to play nice with generated files. + ;; Any race condition is intrinsic to the limited timestamp resolution. + (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)) + ;; Shouldn't that be an error instead? (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. + (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 + )) (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)))) + (and all-present ;; if all filesystem effects are up-to-date + up-to-date-p + (operation-done-p o c) ;; and there's no invalidating reason. + (not (action-forced-p (forcing (or plan *asdf-session*)) 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 + out-op ;; A file-creating op is done when all files are up to date. + ;; An image-effecting operation is done when + (and (status-done-p dep-status) ;; all the dependencies were done, and + (multiple-value-bind (perform-stamp perform-done-p) + (component-operation-time o c) + (and perform-done-p ;; the op was actually run, + (equal perform-stamp done-stamp)))))) ;; with a matching stamp. ;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet - (values t nil))))) - + (values nil nil))))) -;;;; Generic support for plan-traversal -(with-upgradability () - (defmethod initialize-instance :after ((plan plan-traversal) - &key force force-not system - &allow-other-keys) - (with-slots (forced forced-not) plan - (setf forced (normalize-forced-systems force system)) - (setf forced-not (normalize-forced-not-systems force-not system)))) - - (defgeneric plan-actions (plan) - (:documentation "Extract from a plan a list of actions to perform in sequence")) - (defmethod plan-actions ((plan list)) - plan) - - (defmethod (setf plan-action-status) (new-status (p plan-traversal) (o operation) (c component)) - (setf (gethash (cons o c) (plan-visited-actions p)) new-status)) - - (defmethod plan-action-status ((p plan-traversal) (o operation) (c component)) - (or (and (action-forced-not-p p o c) (plan-action-status nil o c)) - (values (gethash (cons o c) (plan-visited-actions p))))) - (defmethod action-valid-p ((p plan-traversal) (o operation) (s system)) - (and (not (action-forced-not-p p o s)) (call-next-method))) - - (defgeneric plan-record-dependency (plan operation component) - (:documentation "Record an action as a dependency in the current plan"))) - - -;;;; Detection of circular dependencies +;;;; The four different actual traversals: +;; * TRAVERSE-ACTION o c T: Ensure all dependencies are either up-to-date in-image, or planned +;; * TRAVERSE-ACTION o c NIL: Ensure all dependencies are up-to-date or planned, in-image or not +;; * ACTION-UP-TO-DATE-P: Check whether some (defsystem-depends-on ?) dependencies are up to date +;; * COLLECT-ACTION-DEPENDENCIES: Get the dependencies (filtered), don't change any status (with-upgradability () - (define-condition circular-dependency (system-definition-error) - ((actions :initarg :actions :reader circular-dependency-actions)) - (:report (lambda (c s) - (format s (compatfmt "~@<Circular dependency: ~3i~_~S~@:>") - (circular-dependency-actions c))))) - - (defgeneric call-while-visiting-action (plan operation component function) - (:documentation "Detect circular dependencies")) - - (defmethod call-while-visiting-action ((plan plan-traversal) operation component fun) - (with-accessors ((action-set plan-visiting-action-set) - (action-list plan-visiting-action-list)) plan - (let ((action (make-action operation component))) - (when (gethash action action-set) - (error 'circular-dependency :actions - (member action (reverse action-list) :test 'equal))) - (setf (gethash action action-set) t) - (push action action-list) - (unwind-protect - (funcall fun) - (pop action-list) - (setf (gethash action action-set) nil))))) - - ;; Syntactic sugar for call-while-visiting-action - (defmacro while-visiting-action ((p o c) &body body) - `(call-while-visiting-action ,p ,o ,c #'(lambda () ,@body)))) - -;;;; Actual traversal: traverse-action -(with-upgradability () - (defgeneric traverse-action (plan operation component needed-in-image-p)) + ;; Compute the action status for a newly visited action. + (defun compute-action-status (plan operation component need-p) + (multiple-value-bind (stamp done-p) + (compute-action-stamp plan operation component) + (assert (or stamp (not done-p))) + (make-action-status + :bits (logior (if stamp #.+keep-bit+ 0) + (if done-p #.+done-bit+ 0) + (if need-p #.+need-bit+ 0)) + :stamp stamp + :level (operate-level) + :index (incf (total-action-count *asdf-session*))))) ;; TRAVERSE-ACTION, in the context of a given PLAN object that accumulates dependency data, ;; visits the action defined by its OPERATION and COMPONENT arguments, ;; and all its transitive dependencies (unless already visited), ;; in the context of the action being (or not) NEEDED-IN-IMAGE-P, ;; i.e. needs to be done in the current image vs merely have been done in a previous image. - ;; For actions that are up-to-date, it returns a STAMP identifying the state of the action - ;; (that's timestamp, but it could be a cryptographic digest in some ASDF extension), - ;; or T if the action needs to be done again. + ;; + ;; TRAVERSE-ACTION updates the VISITED-ACTIONS entries for the action and for all its + ;; transitive dependencies (that haven't been sufficiently visited so far). + ;; It does not return any usable value. ;; ;; Note that for an XCVB-like plan with one-image-per-file-outputting-action, ;; the below method would be insufficient, since it assumes a single image ;; to traverse each node at most twice; non-niip actions would be traversed only once, ;; but niip nodes could be traversed once per image, i.e. once plus once per non-niip action. - (defmethod traverse-action (plan operation component needed-in-image-p) + (defun traverse-action (plan operation component needed-in-image-p) (block nil - ;; ACTION-VALID-P among other things, handles forcing logic, including FORCE-NOT, - ;; and IF-FEATURE filtering. - (unless (action-valid-p plan operation component) (return nil)) - ;; the following hook is needed by POIU, which tracks a full dependency graph, - ;; instead of just a dependency order as in vanilla ASDF - (plan-record-dependency plan operation component) - ;; needed in image distinguishes b/w things that must happen in the - ;; current image and those things that simply need to have been done in a previous one. - (let* ((aniip (needed-in-image-p operation component)) ; action-specific needed-in-image - ;; effective niip: meaningful for the action and required by the plan as traversed - (eniip (and aniip needed-in-image-p)) - ;; status: have we traversed that action previously, and if so what was its status? - (status (plan-action-status plan operation component))) - (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 - (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))))) + (unless (action-valid-p operation component) (return)) + ;; Record the dependency. This hook is needed by POIU, which tracks a full dependency graph, + ;; instead of just a dependency order as in vanilla ASDF. + ;; TODO: It is also needed to detect OPERATE-in-PERFORM. + (record-dependency plan operation component) + (while-visiting-action (operation component) ; maintain context, handle circularity. + ;; needed-in-image distinguishes b/w things that must happen in the + ;; current image and those things that simply need to have been done in a previous one. + (let* ((aniip (needed-in-image-p operation component)) ; action-specific needed-in-image + ;; effective niip: meaningful for the action and required by the plan as traversed + (eniip (and aniip needed-in-image-p)) + ;; status: have we traversed that action previously, and if so what was its status? + (status (action-status plan operation component)) + (level (operate-level))) + (when (and status + (or (status-done-p status) ;; all done + (and (status-need-p status) (<= level (status-level status))) ;; already visited + (and (status-keep-p status) (not eniip)))) ;; up-to-date and not eniip + (return)) ; Already visited with sufficient need-in-image level! + (labels ((visit-action (niip) ; We may visit the action twice, once with niip NIL, then T + (map-direct-dependencies ; recursively traverse dependencies + operation component #'(lambda (o c) (traverse-action plan o c niip))) + ;; AFTER dependencies have been traversed, compute action stamp + (let* ((status (if status + (mark-status-needed status level) + (compute-action-status plan operation component t))) + (out-of-date-p (not (status-keep-p status))) + (to-perform-p (or out-of-date-p (and niip (not (status-done-p status)))))) (cond ; it needs be done if it's out of date or needed in image but absent - ((and add-to-plan-p (not niip)) ; if we need to do it, + ((and out-of-date-p (not niip)) ; if we need to do it, (visit-action t)) ; then we need to do it *in the (current) image*! (t - (setf (plan-action-status plan operation component) ; update status: - (make-instance - 'planned-action-status - :stamp stamp ; computed stamp - :done-p (and done-p (not add-to-plan-p)) ; done *and* up-to-date? - :planned-p add-to-plan-p ; included in list of things to be done? - :index (if status ; index of action amongst all nodes in traversal - (action-index status) ;; if already visited, keep index - (incf (plan-total-action-count plan))))) ; else new index - (when (and done-p (not add-to-plan-p)) - (setf (component-operation-time operation component) stamp)) - (when add-to-plan-p ; if it needs to be added to the plan, - (incf (plan-planned-action-count plan)) ; count it - (unless aniip ; if it's output-producing, - (incf (plan-planned-output-action-count plan)))) ; count it - stamp)))))) ; return the stamp - (while-visiting-action (plan operation component) ; maintain context, handle circularity. - (visit-action eniip))))))) ; visit the action - - -;;;; Sequential plans (the default) -(with-upgradability () - (defclass sequential-plan (plan-traversal) - ((actions-r :initform nil :accessor plan-actions-r)) - (:documentation "Simplest, default plan class, accumulating a sequence of actions")) - - (defmethod plan-actions ((plan sequential-plan)) - (reverse (plan-actions-r plan))) - - ;; No need to record a dependency to build a full graph, just accumulate nodes in order. - (defmethod plan-record-dependency ((plan sequential-plan) (o operation) (c component)) - (values)) - - (defmethod (setf plan-action-status) :after - (new-status (p sequential-plan) (o operation) (c component)) - (when (action-planned-p new-status) - (push (make-action o c) (plan-actions-r 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 "Generate and return a plan for performing OPERATION on COMPONENT.")) - (define-convenience-action-methods make-plan (plan-class operation component &key)) - - (defgeneric perform-plan (plan &key) - (:documentation "Actually perform a plan and build the requested actions")) - (defgeneric plan-operates-on-p (plan component) - (:documentation "Does this PLAN include any operation on given COMPONENT?")) - - (defvar *default-plan-class* 'sequential-plan - "The default plan class to use when building with ASDF") - - (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*) - :system (component-system c) keys))) - (traverse-action plan o c t) - plan)) - - (defmethod perform-plan :around ((plan t) &key) - #+xcl (declare (ignorable plan)) - (let ((*package* *package*) - (*readtable* *readtable*)) - (with-compilation-unit () ;; backward-compatibility. - (call-next-method)))) ;; Going forward, see deferred-warning support in lisp-build. - - (defmethod perform-plan ((plan t) &rest keys &key &allow-other-keys) - (apply 'perform-plan (plan-actions plan) keys)) - - (defmethod perform-plan ((steps list) &key force &allow-other-keys) - (loop* :for action :in steps - :as o = (action-operation action) - :as c = (action-component action) - :when (or force (not (nth-value 1 (compute-action-stamp nil o c)))) - :do (perform-with-restarts o c))) - - (defmethod plan-operates-on-p ((plan plan-traversal) (component-path list)) - (plan-operates-on-p (plan-actions plan) component-path)) + (setf (action-status plan operation component) status) + (when (status-done-p status) + (setf (component-operation-time operation component) + (status-stamp status))) + (when to-perform-p ; if it needs to be added to the plan, count it + (incf (planned-action-count *asdf-session*)) + (unless aniip ; if it's output-producing, count it + (incf (planned-output-action-count *asdf-session*))))))))) + (visit-action eniip)))))) ; visit the action + + ;; NB: This is not an error, not a warning, but a normal expected condition, + ;; to be to signaled by FIND-SYSTEM when it detects an out-of-date system, + ;; *before* it tries to replace it with a new definition. + (define-condition system-out-of-date (condition) + ((name :initarg :name :reader component-name)) + (:documentation "condition signaled when a system is detected as being out of date") + (:report (lambda (c s) + (format s "system ~A is out of date" (component-name c))))) - (defmethod plan-operates-on-p ((plan list) (component-path list)) - (find component-path (mapcar 'action-component plan) - :test 'equal :key 'component-find-path))) + (defun action-up-to-date-p (plan operation component) + "Check whether an action was up-to-date at the beginning of the session. +Update the VISITED-ACTIONS table with the known status, but don't add anything to the PLAN." + (block nil + (unless (action-valid-p operation component) (return t)) + (while-visiting-action (operation component) ; maintain context, handle circularity. + ;; Do NOT record the dependency: it might be out of date. + (let ((status (or (action-status plan operation component) + (setf (action-status plan operation component) + (let ((dependencies-up-to-date-p + (handler-case + (block nil + (map-direct-dependencies + operation component + #'(lambda (o c) + (unless (action-up-to-date-p plan o c) + (return nil)))) + t) + (system-out-of-date () nil)))) + (if dependencies-up-to-date-p + (compute-action-status plan operation component nil) + +status-void+)))))) + (and (status-keep-p status) (status-stamp status))))))) ;;;; Incidental traversals @@ -10130,82 +10209,131 @@ initialized with SEED." ;;; files required by a bundling operation. (with-upgradability () (defclass filtered-sequential-plan (sequential-plan) - ((action-filter :initform t :initarg :action-filter :reader plan-action-filter) - (component-type :initform t :initarg :component-type :reader plan-component-type) + ((component-type :initform t :initarg :component-type :reader plan-component-type) (keep-operation :initform t :initarg :keep-operation :reader plan-keep-operation) (keep-component :initform t :initarg :keep-component :reader plan-keep-component)) (:documentation "A variant of SEQUENTIAL-PLAN that only records a subset of actions.")) (defmethod initialize-instance :after ((plan filtered-sequential-plan) - &key force force-not - other-systems) - (declare (ignore force force-not)) + &key system other-systems) ;; Ignore force and force-not, rely on other-systems: ;; force traversal of what we're interested in, i.e. current system or also others; ;; force-not traversal of what we're not interested in, i.e. other systems unless other-systems. - (with-slots (forced forced-not action-filter system) plan - (setf forced (normalize-forced-systems (if other-systems :all t) system)) - (setf forced-not (normalize-forced-not-systems (if other-systems nil t) system)) - (setf action-filter (ensure-function action-filter)))) - - (defmethod action-valid-p ((plan filtered-sequential-plan) o c) - (and (funcall (plan-action-filter plan) o c) - (typep c (plan-component-type plan)) - (call-next-method))) - - (defun* (traverse-actions) (actions &rest keys &key plan-class &allow-other-keys) - "Given a list of actions, build a plan with these actions as roots." - (let ((plan (apply 'make-instance (or plan-class 'filtered-sequential-plan) keys))) - (loop* :for action :in actions - :as o = (action-operation action) - :as c = (action-component action) - :do (traverse-action plan o c t)) - plan)) - - (defgeneric traverse-sub-actions (operation component &key &allow-other-keys)) - (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 t operation component) - :system (component-system component) keys)) + (setf (slot-value plan 'forcing) + (make-forcing :system system :force :all :force-not (if other-systems nil t)))) (defmethod plan-actions ((plan filtered-sequential-plan)) (with-slots (keep-operation keep-component) plan - (loop* :for action :in (call-next-method) - :as o = (action-operation action) - :as c = (action-component action) - :when (and (typep o keep-operation) (typep c keep-component)) - :collect (make-action o c)))) + (loop :for action :in (call-next-method) + :as o = (action-operation action) + :as c = (action-component action) + :when (and (typep o keep-operation) (typep c keep-component)) + :collect (make-action o c)))) + + (defun collect-action-dependencies (plan operation component) + (when (action-valid-p operation component) + (while-visiting-action (operation component) ; maintain context, handle circularity. + (let ((action (make-action operation component))) + (unless (nth-value 1 (gethash action (visited-actions *asdf-session*))) + (setf (gethash action (visited-actions *asdf-session*)) nil) + (when (and (typep component (plan-component-type plan)) + (not (action-forced-not-p (forcing plan) operation component))) + (map-direct-dependencies operation component + #'(lambda (o c) (collect-action-dependencies plan o c))) + (push action (plan-actions-r plan)))))))) + + (defgeneric collect-dependencies (operation component &key &allow-other-keys) + (:documentation "Given an action, build a plan for all of its dependencies.")) + (define-convenience-action-methods collect-dependencies (operation component &key)) + (defmethod collect-dependencies ((operation operation) (component component) + &rest keys &key &allow-other-keys) + (let ((plan (apply 'make-instance 'filtered-sequential-plan + :system (component-system component) keys))) + (loop :for action :in (direct-dependencies operation component) + :do (collect-action-dependencies plan (action-operation action) (action-component action))) + (plan-actions plan))) + + (defun* (required-components) (system &rest keys &key (goal-operation 'load-op) &allow-other-keys) + "Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and +return a list of the components involved in building the desired action." + (with-asdf-session (:override t) + (remove-duplicates + (mapcar 'action-component + (apply 'collect-dependencies goal-operation system + (remove-plist-key :goal-operation keys))) + :from-end t)))) + + +;;;; High-level interface: make-plan, perform-plan +(with-upgradability () + (defgeneric make-plan (plan-class operation component &key &allow-other-keys) + (:documentation "Generate and return a plan for performing OPERATION on COMPONENT.")) + (define-convenience-action-methods make-plan (plan-class operation component &key)) + + (defgeneric mark-as-done (plan-class operation component) + (:documentation "Mark an action as done in a plan, after performing it.")) + (define-convenience-action-methods mark-as-done (plan-class operation component)) + + (defgeneric perform-plan (plan &key) + (:documentation "Actually perform a plan and build the requested actions")) + + (defparameter* *plan-class* 'sequential-plan + "The default plan class to use when building with ASDF") + + (defmethod make-plan (plan-class (o operation) (c component) &rest keys &key &allow-other-keys) + (with-asdf-session () + (let ((plan (apply 'make-instance (or plan-class *plan-class*) keys))) + (traverse-action plan o c t) + plan))) - (defun* (required-components) (system &rest keys &key (goal-operation 'load-op) &allow-other-keys) - "Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and -return a list of the components involved in building the desired action." - (remove-duplicates - (mapcar 'action-component - (plan-actions - (apply 'traverse-sub-actions goal-operation system - (remove-plist-key :goal-operation keys)))) - :from-end t))) + (defmethod perform-plan :around ((plan t) &key) + (assert (performable-p (forcing plan)) () "plan not performable") + (let ((*package* *package*) + (*readtable* *readtable*)) + (with-compilation-unit () ;; backward-compatibility. + (call-next-method)))) ;; Going forward, see deferred-warning support in lisp-build. + (defun action-already-done-p (plan operation component) + (if-let (status (action-status plan operation component)) + (status-done-p status))) + + (defmethod perform-plan ((plan t) &key) + (loop :for action :in (plan-actions plan) + :as o = (action-operation action) + :as c = (action-component action) :do + (unless (action-already-done-p plan o c) + (perform-with-restarts o c) + (mark-as-done plan o c)))) + + (defmethod mark-as-done ((plan plan) (o operation) (c component)) + (let ((plan-status (action-status plan o c)) + (perform-status (action-status nil o c))) + (assert (and (status-stamp perform-status) (status-keep-p perform-status)) () + "Just performed ~A but failed to mark it done" (action-description o c)) + (setf (action-status plan o c) + (make-action-status + :bits (logior (status-bits plan-status) +done-bit+) + :stamp (status-stamp perform-status) + :level (status-level plan-status) + :index (status-index plan-status)))))) ;;;; ------------------------------------------------------------------------- ;;;; Invoking Operations (uiop/package:define-package :asdf/operate (:recycle :asdf/operate :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache - :asdf/component :asdf/system :asdf/operation :asdf/action - :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session + :asdf/component :asdf/system :asdf/system-registry :asdf/find-component + :asdf/operation :asdf/action :asdf/lisp-action :asdf/forcing :asdf/plan) (:export - #:operate #:oos - #:build-op #:make + #:operate #:oos #:build-op #:make #:load-system #:load-systems #:load-systems* - #:compile-system #:test-system #:require-system - #:module-provide-asdf - #:component-loaded-p #:already-loaded-systems)) + #:compile-system #:test-system #:require-system #:module-provide-asdf + #:component-loaded-p #:already-loaded-systems + #:recursive-operate)) (in-package :asdf/operate) (with-upgradability () - (defgeneric operate (operation component &key &allow-other-keys) + (defgeneric operate (operation component &key) (:documentation "Operate does mainly four things for the user: @@ -10220,6 +10348,7 @@ The entire computation is wrapped in WITH-COMPILATION-UNIT and error handling co If a VERSION argument is supplied, then operate also ensures that the system found satisfies it using the VERSION-SATISFIES method. If a PLAN-CLASS argument is supplied, that class is used for the plan. +If a PLAN-OPTIONS argument is supplied, the options are passed to the plan. The :FORCE or :FORCE-NOT argument to OPERATE can be: T to force the inside of the specified system to be rebuilt (resp. not), @@ -10235,52 +10364,60 @@ But do NOT depend on it, for this is deprecated behavior.")) (define-convenience-action-methods operate (operation component &key) :if-no-component (error 'missing-component :requires component)) - (defvar *in-operate* nil - "Are we in operate?") - ;; This method ensures that an ASDF upgrade is attempted as the very first thing, ;; with suitable state preservation in case in case it actually happens, ;; and that a few suitable dynamic bindings are established. (defmethod operate :around (operation component &rest keys &key verbose (on-warnings *compile-file-warnings-behaviour*) - (on-failure *compile-file-failure-behaviour*) &allow-other-keys) + (on-failure *compile-file-failure-behaviour*)) (nest - (with-asdf-cache ()) - (let ((in-operate *in-operate*) - (*in-operate* t) - (operation-remaker ;; how to remake the operation after ASDF was upgraded (if it was) - (etypecase operation - (operation (let ((name (type-of operation))) - #'(lambda () (make-operation name)))) - ((or symbol string) (constantly operation)))) - (component-path (typecase component ;; to remake the component after ASDF upgrade - (component (component-find-path component)) - (t component))))) - ;; Before we operate on any system, make sure ASDF is up-to-date, - ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble. - (progn - (unless in-operate + (with-asdf-session ()) + (let* ((operation-remaker ;; how to remake the operation after ASDF was upgraded (if it was) + (etypecase operation + (operation (let ((name (type-of operation))) + #'(lambda () (make-operation name)))) + ((or symbol string) (constantly operation)))) + (component-path (typecase component ;; to remake the component after ASDF upgrade + (component (component-find-path component)) + (t component))) + (system-name (labels ((first-name (x) + (etypecase x + ((or string symbol) x) ; NB: includes the NIL case. + (cons (or (first-name (car x)) (first-name (cdr x))))))) + (coerce-name (first-name component-path))))) + (apply 'make-forcing :performable-p t :system system-name keys) + ;; Before we operate on any system, make sure ASDF is up-to-date, + ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble. + (unless (asdf-upgraded-p (toplevel-asdf-session)) + (setf (asdf-upgraded-p (toplevel-asdf-session)) t) (when (upgrade-asdf) ;; If we were upgraded, restart OPERATE the hardest of ways, for ;; its function may have been redefined. (return-from operate - (apply 'operate (funcall operation-remaker) component-path keys))))) + (with-asdf-session (:override t :override-cache t) + (apply 'operate (funcall operation-remaker) component-path keys)))))) ;; Setup proper bindings around any operate call. (let* ((*verbose-out* (and verbose *standard-output*)) (*compile-file-warnings-behaviour* on-warnings) - (*compile-file-failure-behaviour* on-failure)) - (call-next-method)))) + (*compile-file-failure-behaviour* on-failure))) + (unwind-protect + (progn + (incf (operate-level)) + (call-next-method)) + (decf (operate-level))))) (defmethod operate :before ((operation operation) (component component) - &key version &allow-other-keys) + &key version) (unless (version-satisfies component version) - (error 'missing-component-of-version :requires component :version version))) + (error 'missing-component-of-version :requires component :version version)) + (record-dependency nil operation component)) (defmethod operate ((operation operation) (component component) - &rest keys &key plan-class &allow-other-keys) - (let ((plan (apply 'make-plan plan-class operation component keys))) - (apply 'perform-plan plan keys) + &key plan-class plan-options) + (let ((plan (apply 'make-plan plan-class operation component + :forcing (forcing *asdf-session*) plan-options))) + (perform-plan plan) (values operation plan))) (defun oos (operation component &rest args &key &allow-other-keys) @@ -10288,8 +10425,19 @@ But do NOT depend on it, for this is deprecated behavior.")) (setf (documentation 'oos 'function) (format nil "Short for _operate on system_ and an alias for the OPERATE function.~%~%~a" - (documentation 'operate 'function)))) + (documentation 'operate 'function))) + (define-condition recursive-operate (warning) + ((operation :initarg :operation :reader condition-operation) + (component :initarg :component :reader condition-component) + (action :initarg :action :reader condition-action)) + (:report (lambda (c s) + (format s (compatfmt "~@<Deprecated recursive use of (~S '~S '~S) while visiting ~S ~ +- please use proper dependencies instead~@:>") + 'operate + (type-of (condition-operation c)) + (component-find-path (condition-component c)) + (action-path (condition-action c))))))) ;;;; Common operations (when-upgrading () @@ -10349,17 +10497,11 @@ defaults to LOAD-OP, to load it in current image." "Has the given COMPONENT been successfully loaded in the current image (yet)? Note that this returns true even if the component is not up to date." (if-let ((component (find-component component () :registered t))) - (action-already-done-p nil (make-operation 'load-op) component))) + (nth-value 1 (component-operation-time (make-operation 'load-op) component)))) (defun already-loaded-systems () "return a list of the names of the systems that have been successfully loaded so far" - (mapcar 'coerce-name (remove-if-not 'component-loaded-p (registered-systems*)))) - - (defun require-system (system &rest keys &key &allow-other-keys) - "Ensure the specified SYSTEM is loaded, passing the KEYS to OPERATE, but do not update the -system or its dependencies if they have already been loaded." - (unless (component-loaded-p system) - (apply 'load-system system :force-not (already-loaded-systems) keys)))) + (mapcar 'coerce-name (remove-if-not 'component-loaded-p (registered-systems*))))) ;;;; Define the class REQUIRE-SYSTEM, to be hooked into CL:REQUIRE when possible, @@ -10418,7 +10560,7 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (let ((*modules-being-required* (cons module-name *modules-being-required*)) #+sbcl (sb-impl::*requiring* (remove module-name sb-impl::*requiring* :test 'equal))) (handler-bind - ((style-warning #'muffle-warning) + (((or style-warning recursive-operate) #'muffle-warning) (missing-component (constantly nil)) (fatal-condition #'(lambda (e) @@ -10427,7 +10569,11 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (let ((*verbose-out* (make-broadcast-stream))) (let ((system (find-system system-name nil))) (when system - (require-system system-name :verbose nil) + ;; Do not use require-system after all, use load-system: + ;; on the one hand, REQUIRE already uses *MODULES* not to load something twice, + ;; on the other hand, REQUIRE-SYSTEM uses FORCE-NOT which may conflict with + ;; the toplevel session forcing settings. + (load-system system :verbose nil) t))))))))) @@ -10436,32 +10582,314 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (defun restart-upgraded-asdf () ;; If we're in the middle of something, restart it. (let ((systems-being-defined - (when *asdf-cache* + (when *asdf-session* (prog1 - (loop :for k :being :the hash-keys :of *asdf-cache* + (loop :for k :being :the hash-keys :of (asdf-cache) :when (eq (first k) 'find-system) :collect (second k)) - (clrhash *asdf-cache*))))) + (clrhash (asdf-cache)))))) ;; Regardless, clear defined systems, since they might be invalid ;; after an incompatible ASDF upgrade. - (clear-defined-systems) + (clear-registered-systems) ;; The configuration also may have to be upgraded. (upgrade-configuration) ;; If we were in the middle of an operation, be sure to restore the system being defined. (dolist (s systems-being-defined) (find-system s nil)))) - (register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf) + (register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf)) +;;;; ------------------------------------------------------------------------- +;;;; Finding systems + +(uiop/package:define-package :asdf/find-system + (:recycle :asdf/find-system :asdf) + (:use :uiop/common-lisp :uiop :asdf/upgrade + :asdf/session :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/lisp-action + :asdf/find-component :asdf/system-registry :asdf/plan :asdf/operate) + (:import-from #:asdf/component #:%additional-input-files) + (:export + #:find-system #:locate-system #:load-asd #:define-op + #:load-system-definition-error #:error-name #:error-pathname #:error-condition)) +(in-package :asdf/find-system) + +(with-upgradability () + (define-condition load-system-definition-error (system-definition-error) + ((name :initarg :name :reader error-name) + (pathname :initarg :pathname :reader error-pathname) + (condition :initarg :condition :reader error-condition)) + (:report (lambda (c s) + (format s (compatfmt "~@<Error while trying to load definition for system ~A from pathname ~A: ~3i~_~A~@:>") + (error-name c) (error-pathname c) (error-condition c))))) + + + ;;; Methods for find-system + + ;; Reject NIL as a system designator. + (defmethod find-system ((name null) &optional (error-p t)) + (when error-p + (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>")))) + + ;; Default method for find-system: resolve the argument using COERCE-NAME. + (defmethod find-system (name &optional (error-p t)) + (find-system (coerce-name name) error-p)) + + (defun find-system-if-being-defined (name) + ;; This function finds systems being defined *in the current ASDF session*, as embodied by + ;; its session cache, even before they are fully defined and registered in *registered-systems*. + ;; The purpose of this function is to prevent races between two files that might otherwise + ;; try overwrite each other's system objects, resulting in infinite loops and stack overflow. + ;; This function explicitly MUST NOT find definitions merely registered in previous sessions. + ;; NB: this function depends on a corresponding side-effect in parse-defsystem; + ;; the precise protocol between the two functions may change in the future (or not). + (first (gethash `(find-system ,(coerce-name name)) (asdf-cache)))) + + (defclass define-op (non-propagating-operation) () + (:documentation "An operation to record dependencies on loading a .asd file.")) + + (defmethod record-dependency ((plan null) (operation t) (component t)) + (unless (or (typep operation 'define-op) + (and (typep operation 'load-op) + (typep component 'system) + (equal "asdf" (coerce-name component)))) + (if-let ((action (first (visiting-action-list *asdf-session*)))) + (let ((parent-operation (action-operation action)) + (parent-component (action-component action))) + (cond + ((and (typep parent-operation 'define-op) + (typep parent-component 'system)) + (let ((action (cons operation component))) + (unless (gethash action (definition-dependency-set parent-component)) + (push (cons operation component) (definition-dependency-list parent-component)) + (setf (gethash action (definition-dependency-set parent-component)) t)))) + (t + (warn 'recursive-operate + :operation operation :component component :action action))))))) + + (defmethod component-depends-on ((o define-op) (s system)) + `(;;NB: 1- ,@(system-defsystem-depends-on s)) ; Should be already included in the below. + ;; 2- We don't call-next-method to avoid other methods + ,@(loop* :for (o . c) :in (definition-dependency-list s) :collect (list o c)))) + + (defmethod component-depends-on ((o operation) (s system)) + `(,@(when (and (not (typep o 'define-op)) + (or (system-source-file s) (definition-dependency-list s))) + `((define-op ,(primary-system-name s)))) + ,@(call-next-method))) + + (defmethod perform ((o operation) (c undefined-system)) + (sysdef-error "Trying to use undefined or incompletely defined system ~A" (coerce-name c))) + + ;; TODO: could this file be refactored so that locate-system is merely + ;; the cache-priming call to input-files here? + (defmethod input-files ((o define-op) (s system)) + (assert (equal (coerce-name s) (primary-system-name s))) + (if-let ((asd (system-source-file s))) (list asd))) + + (defmethod perform ((o define-op) (s system)) + (assert (equal (coerce-name s) (primary-system-name s))) + (nest + (if-let ((pathname (first (input-files o s))))) + (with-standard-io-syntax) + (let ((*print-readably* nil) + ;; Note that our backward-compatible *readtable* is + ;; a global readtable that gets globally side-effected. Ouch. + ;; Same for the *print-pprint-dispatch* table. + ;; We should do something about that for ASDF3 if possible, or else ASDF4. + (*readtable* *readtable*) + (*print-pprint-dispatch* *print-pprint-dispatch*) + (*package* (find-package :asdf-user)) + (*default-pathname-defaults* + ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings. + (pathname-directory-pathname (physicalize-pathname pathname))))) + (handler-bind + (((and error (not missing-component)) + #'(lambda (condition) + (error 'load-system-definition-error + :name (coerce-name s) :pathname pathname :condition condition)))) + (asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%") + (coerce-name s) pathname) + ;; dependencies will depend on what's loaded via definition-dependency-list + (unset-asdf-cache-entry `(component-depends-on ,o ,s)) + (unset-asdf-cache-entry `(input-files ,o ,s))) + (load* pathname :external-format (encoding-external-format (detect-encoding pathname))))) + + (defun load-asd (pathname &key name) + "Load system definitions from PATHNAME. +NAME if supplied is the name of a system expected to be defined in that file. + +Do NOT try to load a .asd file directly with CL:LOAD. Always use ASDF:LOAD-ASD." + (with-asdf-session () + ;; TODO: use OPERATE, so we consult the cache and only load once per session. + (flet ((do-it (o c) (operate o c))) + (let ((primary-name (primary-system-name (or name (pathname-name pathname)))) + (operation (make-operation 'define-op))) + (if-let (system (registered-system primary-name)) + (progn + ;; We already determine this to be obsolete --- + ;; or should we move some tests from find-system to check for up-to-date-ness here? + (setf (component-operation-time operation system) t + (definition-dependency-list system) nil + (definition-dependency-set system) (list-to-hash-set nil)) + (do-it operation system)) + (let ((system (make-instance 'undefined-system + :name primary-name :source-file pathname))) + (register-system system) + (unwind-protect (do-it operation system) + (when (typep system 'undefined-system) + (clear-system system))))))))) + + (defvar *old-asdf-systems* (make-hash-table :test 'equal)) + + ;; (Private) function to check that a system that was found isn't an asdf downgrade. + ;; Returns T if everything went right, NIL if the system was an ASDF of the same or older version, + ;; that shall not be loaded. Also issue a warning if it was a strictly older version of ASDF. + (defun check-not-old-asdf-system (name pathname) + (or (not (member name '("asdf" "uiop") :test 'equal)) + (null pathname) + (let* ((asdfp (equal name "asdf")) ;; otherwise, it's uiop + (version-pathname + (subpathname pathname "version" :type (if asdfp "lisp-expr" "lisp"))) + (version (and (probe-file* version-pathname :truename nil) + (read-file-form version-pathname :at (if asdfp '(0) '(2 2 2))))) + (old-version (asdf-version))) + (cond + ;; Don't load UIOP of the exact same version: we already loaded it as part of ASDF. + ((and (equal old-version version) (equal name "uiop")) nil) + ((version<= old-version version) t) ;; newer or same version: Good! + (t ;; old version: bad + (ensure-gethash + (list (namestring pathname) version) *old-asdf-systems* + #'(lambda () + (let ((old-pathname (system-source-file (registered-system "asdf")))) + (if asdfp + (warn "~@<~ + You are using ASDF version ~A ~:[(probably from (require \"asdf\") ~ + or loaded by quicklisp)~;from ~:*~S~] and have an older version of ASDF ~ + ~:[(and older than 2.27 at that)~;~:*~A~] registered at ~S. ~ + Having an ASDF installed and registered is the normal way of configuring ASDF to upgrade itself, ~ + and having an old version registered is a configuration error. ~ + ASDF will ignore this configured system rather than downgrade itself. ~ + In the future, you may want to either: ~ + (a) upgrade this configured ASDF to a newer version, ~ + (b) install a newer ASDF and register it in front of the former in your configuration, or ~ + (c) uninstall or unregister this and any other old version of ASDF from your configuration. ~ + Note that the older ASDF might be registered implicitly through configuration inherited ~ + from your system installation, in which case you might have to specify ~ + :ignore-inherited-configuration in your in your ~~/.config/common-lisp/source-registry.conf ~ + or other source-registry configuration file, environment variable or lisp parameter. ~ + Indeed, a likely offender is an obsolete version of the cl-asdf debian or ubuntu package, ~ + that you might want to upgrade (if a recent enough version is available) ~ + or else remove altogether (since most implementations ship with a recent asdf); ~ + if you lack the system administration rights to upgrade or remove this package, ~ + then you might indeed want to either install and register a more recent version, ~ + or use :ignore-inherited-configuration to avoid registering the old one. ~ + Please consult ASDF documentation and/or experts.~@:>~%" + old-version old-pathname version pathname) + ;; NB: for UIOP, don't warn, just ignore. + (warn "ASDF ~A (from ~A), UIOP ~A (from ~A)" + old-version old-pathname version pathname) + )))) + nil))))) ;; only issue the warning the first time, but always return nil + + (defun locate-system (name) + "Given a system NAME designator, try to locate where to load the system from. +Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME +FOUNDP is true when a system was found, +either a new unregistered one or a previously registered one. +FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed. +PATHNAME when not null is a path from which to load the system, +either associated with FOUND-SYSTEM, or with the PREVIOUS system. +PREVIOUS when not null is a previously loaded SYSTEM object of same name. +PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded." + (with-asdf-session () ;; NB: We don't cache the results. We once used to, but it wasn't useful, + ;; and keeping a negative cache was a bug (see lp#1335323), which required + ;; explicit invalidation in clear-system and find-system (when unsucccessful). + (let* ((name (coerce-name name)) + (previous (registered-system name)) ; load from disk if absent or newer on disk + (primary (registered-system (primary-system-name name))) + (previous-time (and previous primary (component-operation-time 'define-op primary))) + (found (search-for-system-definition name)) + (found-system (and (typep found 'system) found)) + (pathname (ensure-pathname + (or (and (typep found '(or pathname string)) (pathname found)) + (system-source-file found-system) + (system-source-file previous)) + :want-absolute t :resolve-symlinks *resolve-symlinks*)) + (foundp (and (or found-system pathname previous) t))) + (check-type found (or null pathname system)) + (unless (check-not-old-asdf-system name pathname) + (check-type previous system) ;; asdf is preloaded, so there should be a previous one. + (setf found-system nil pathname nil)) + (values foundp found-system pathname previous previous-time)))) + + ;; Main method for find-system: first, make sure the computation is memoized in a session cache. + ;; Unless the system is immutable, use locate-system to find the primary system; + ;; reconcile the finding (if any) with any previous definition (in a previous session, + ;; preloaded, with a previous configuration, or before filesystem changes), and + ;; load a found .asd if appropriate. Finally, update registration table and return results. - ;; The following function's symbol is from asdf/find-system. - ;; It is defined here to resolve what would otherwise be forward package references. + (defun definition-dependencies-up-to-date-p (system) + (check-type system system) + (assert (primary-system-p system)) + (handler-case + (loop :with plan = (make-instance *plan-class*) + :for action :in (definition-dependency-list system) + :always (action-up-to-date-p + plan (action-operation action) (action-component action)) + :finally + (let ((o (make-operation 'define-op))) + (multiple-value-bind (stamp done-p) + (compute-action-stamp plan o system) + (return (and (stamp<= stamp (component-operation-time o system)) + done-p))))) + (system-out-of-date () nil))) + + (defmethod find-system ((name string) &optional (error-p t)) + (nest + (with-asdf-session (:key `(find-system ,name))) + (let ((name-primary-p (primary-system-p name))) + (unless name-primary-p (find-system (primary-system-name name) nil))) + (or (and *immutable-systems* (gethash name *immutable-systems*) (registered-system name))) + (multiple-value-bind (foundp found-system pathname previous previous-time) + (locate-system name) + (assert (eq foundp (and (or found-system pathname previous) t)))) + (let ((previous-pathname (system-source-file previous)) + (system (or previous found-system))) + (when (and found-system (not previous)) + (register-system found-system)) + (when (and system pathname) + (setf (system-source-file system) pathname)) + (if-let ((stamp (get-file-stamp pathname))) + (let ((up-to-date-p + (and previous + (or (pathname-equal pathname previous-pathname) + (and pathname previous-pathname + (pathname-equal + (physicalize-pathname pathname) + (physicalize-pathname previous-pathname)))) + (stamp<= stamp previous-time) + ;; TODO: check that all dependencies are up-to-date. + ;; This necessitates traversing them without triggering + ;; the adding of nodes to the plan. + (or (not name-primary-p) + (definition-dependencies-up-to-date-p previous))))) + (unless up-to-date-p + (restart-case + (signal 'system-out-of-date :name name) + (continue () :report "continue")) + (load-asd pathname :name name))))) + ;; Try again after having loaded from disk if needed + (or (registered-system name) + (when error-p (error 'missing-component :requires name))))) + + ;; Resolved forward reference for asdf/system-registry. (defun mark-component-preloaded (component) "Mark a component as preloaded." (let ((component (find-component component nil :registered t))) ;; Recurse to children, so asdf/plan will hopefully be happy. (map () 'mark-component-preloaded (component-children component)) ;; Mark the timestamps of the common lisp-action operations as 0. - (let ((times (component-operation-times component))) - (dolist (o '(load-op compile-op prepare-op)) - (setf (gethash (make-operation o) times) 0)))))) - + (let ((cot (component-operation-times component))) + (dolist (o `(,@(when (primary-system-p component) '(define-op)) + prepare-op compile-op load-op)) + (setf (gethash (make-operation o) cot) 0)))))) ;;;; ------------------------------------------------------------------------- ;;;; Defsystem @@ -10469,15 +10897,20 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (:recycle :asdf/parse-defsystem :asdf/defsystem :asdf) (:nicknames :asdf/defsystem) ;; previous name, to be compatible with, in case anyone cares (:use :uiop/common-lisp :asdf/driver :asdf/upgrade - :asdf/cache :asdf/component :asdf/system - :asdf/find-system :asdf/find-component :asdf/action :asdf/lisp-action :asdf/operate) + :asdf/session :asdf/component :asdf/system :asdf/system-registry + :asdf/find-component :asdf/action :asdf/lisp-action :asdf/operate) (:import-from :asdf/system #:depends-on #:weakly-depends-on) + ;; these needed for record-additional-system-input-file + (:import-from :asdf/operation #:make-operation) + (:import-from :asdf/component #:%additional-input-files) + (:import-from :asdf/find-system #:define-op) (:export #:defsystem #:register-system-definition #:class-for-type #:*default-component-class* #:determine-system-directory #:parse-component-form #:non-toplevel-system #:non-system-system #:bad-system-name - #:sysdef-error-component #:check-component-input)) + #:sysdef-error-component #:check-component-input + #:explain)) (in-package :asdf/parse-defsystem) ;;; Pathname @@ -10565,6 +10998,27 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ (sysdef-error-component ":components must be NIL or a list of components." type name components))) + + (defun record-additional-system-input-file (pathname component parent) + (let* ((record-on (if parent + (loop :with retval + :for par = parent :then (component-parent par) + :while par + :do (setf retval par) + :finally (return retval)) + component)) + (comp (if (typep record-on 'component) + record-on + ;; at this point there will be no parent for RECORD-ON + (find-component record-on nil))) + (op (make-operation 'define-op)) + (cell (or (assoc op (%additional-input-files comp)) + (let ((new-cell (list op))) + (push new-cell (%additional-input-files comp)) + new-cell)))) + (pushnew pathname (cdr cell) :test 'pathname-equal) + (values))) + ;; Given a form used as :version specification, in the context of a system definition ;; in a file at PATHNAME, for given COMPONENT with given PARENT, normalize the form ;; to an acceptable ASDF-format version. @@ -10585,12 +11039,16 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ (case (first form) ((:read-file-form) (destructuring-bind (subpath &key (at 0)) (rest form) - (safe-read-file-form (subpathname pathname subpath) - :at at :package :asdf-user))) + (let ((path (subpathname pathname subpath))) + (record-additional-system-input-file path component parent) + (safe-read-file-form path + :at at :package :asdf-user)))) ((:read-file-line) (destructuring-bind (subpath &key (at 0)) (rest form) - (safe-read-file-line (subpathname pathname subpath) - :at at))) + (let ((path (subpathname pathname subpath))) + (record-additional-system-input-file path component parent) + (safe-read-file-line (subpathname pathname subpath) + :at at)))) (otherwise (invalid)))) (t @@ -10752,7 +11210,7 @@ system names contained using COERCE-NAME. Return the result." ;; that is registered to a different location to find-system, ;; we also need to remember it in the asdf-cache. (nest - (with-asdf-cache ()) + (with-asdf-session ()) (let* ((name (coerce-name name)) (source-file (if sfp source-file (resolve-symlinks* (load-pathname)))))) (flet ((fix-case (x) (if (logical-pathname-p source-file) (string-downcase x) x)))) @@ -10771,13 +11229,12 @@ system names contained using COERCE-NAME. Return the result." :collect :it))) (load-systems* deps) dep-forms)) - (registered (system-registered-p name)) - (registered! (if registered - (rplaca registered (get-file-stamp source-file)) - (register-system - (make-instance 'system :name name :source-file source-file)))) - (system (reset-system (cdr registered!) - :name name :source-file source-file)) + (system (or (find-system-if-being-defined name) + (if-let (registered (registered-system name)) + (reset-system-class registered 'undefined-system + :name name :source-file source-file) + (register-system (make-instance 'undefined-system + :name name :source-file source-file))))) (component-options (append (remove-plist-keys '(:defsystem-depends-on :class) options) @@ -10793,7 +11250,7 @@ system names contained using COERCE-NAME. Return the result." (unless (subtypep class 'system) (error 'non-system-system :name name :class-name (class-name class))) (unless (eq (type-of system) class) - (change-class system class))) + (reset-system-class system class))) (parse-component-form nil (list* :module name :pathname directory component-options)))) (defmacro defsystem (name &body options) @@ -10804,8 +11261,9 @@ system names contained using COERCE-NAME. Return the result." (uiop/package:define-package :asdf/bundle (:recycle :asdf/bundle :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade - :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation - :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem) + :asdf/component :asdf/system :asdf/operation + :asdf/find-component ;; used by ECL + :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/parse-defsystem) (:export #:bundle-op #:bundle-type #:program-system #:bundle-system #:bundle-pathname-type #:direct-dependency-files @@ -11123,9 +11581,9 @@ or of opaque libraries shipped along the source code.")) ;; your component-depends-on method must gather the correct dependencies in the correct order. (while-collecting (collect) (map-direct-dependencies - 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)))))) + o c #'(lambda (sub-o sub-c) + (loop :for f :in (funcall key sub-o sub-c) + :when (funcall test f) :do (collect f)))))) (defun pathname-type-equal-function (type) #'(lambda (p) (equalp (pathname-type p) type))) @@ -11241,7 +11699,7 @@ or of opaque libraries shipped along the source code.")) :keep-operation 'basic-load-op)) (while-collecting (x) ;; resolve the sideway-dependencies of s (map-direct-dependencies - t 'load-op s + 'load-op s #'(lambda (o c) (when (and (typep o 'load-op) (typep c 'system)) (x c))))))) @@ -11296,7 +11754,6 @@ which is probably not what you want; you probably need to tweak your output tran (perform-lisp-load-fasl o s)) (defmethod component-depends-on ((o load-bundle-op) (s precompiled-system)) - #+xcl (declare (ignorable o)) `((load-op ,s) ,@(call-next-method)))) #| ;; Example use: @@ -11327,7 +11784,7 @@ which is probably not what you want; you probably need to tweak your output tran (defun linkable-system (x) (or (if-let (s (find-system x)) - (and (system-source-file x) s)) + (and (output-files 'lib-op s) s)) (if-let (p (system-module-pathname (coerce-name x))) (make-prebuilt-system x p)))) @@ -11344,7 +11801,8 @@ which is probably not what you want; you probably need to tweak your output tran `((lib-op ,@(unless (no-uiop c) (list (linkable-system "cmp") - (unless (or (gethash "uiop" deps) (gethash "asdf" deps)) + (unless (or (and (gethash "uiop" deps) (linkable-system "uiop")) + (and (gethash "asdf" deps) (linkable-system "asdf"))) (or (linkable-system "uiop") (linkable-system "asdf") "asdf"))))) @@ -11376,7 +11834,7 @@ which is probably not what you want; you probably need to tweak your output tran (:recycle :asdf/concatenate-source :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/operation - :asdf/system :asdf/find-system + :asdf/system :asdf/action :asdf/lisp-action :asdf/plan :asdf/bundle) (:export #:concatenate-source-op @@ -11460,19 +11918,170 @@ into a single file")) (defmethod output-files ((o basic-compile-concatenated-source-op) (s system)) (lisp-compilation-output-files o s)) - (defmethod perform ((o basic-concatenate-source-op) (s system)) - (let* ((ins (input-files o s)) - (out (output-file o s)) - (tmp (tmpize-pathname out))) - (concatenate-files ins tmp) - (rename-file-overwriting-target tmp out))) - (defmethod perform ((o basic-load-concatenated-source-op) (s system)) - (perform-lisp-load-source o s)) - (defmethod perform ((o basic-compile-concatenated-source-op) (s system)) - (perform-lisp-compilation o s)) - (defmethod perform ((o basic-load-compiled-concatenated-source-op) (s system)) - (perform-lisp-load-fasl o s))) + (defmethod perform ((o basic-concatenate-source-op) (s system)) + (let* ((ins (input-files o s)) + (out (output-file o s)) + (tmp (tmpize-pathname out))) + (concatenate-files ins tmp) + (rename-file-overwriting-target tmp out))) + (defmethod perform ((o basic-load-concatenated-source-op) (s system)) + (perform-lisp-load-source o s)) + (defmethod perform ((o basic-compile-concatenated-source-op) (s system)) + (perform-lisp-compilation o s)) + (defmethod perform ((o basic-load-compiled-concatenated-source-op) (s system)) + (perform-lisp-load-fasl o s))) + +;;;; ------------------------------------------------------------------------- +;;;; Package systems in the style of quick-build or faslpath + +(uiop:define-package :asdf/package-inferred-system + (:recycle :asdf/package-inferred-system :asdf/package-system :asdf) + (:use :uiop/common-lisp :uiop + :asdf/upgrade :asdf/session + :asdf/component :asdf/system :asdf/system-registry :asdf/lisp-action + :asdf/parse-defsystem) + (:export + #:package-inferred-system #:sysdef-package-inferred-system-search + #:package-system ;; backward compatibility only. To be removed. + #:register-system-packages + #:*defpackage-forms* #:*package-inferred-systems* #:package-inferred-system-missing-package-error)) +(in-package :asdf/package-inferred-system) + +(with-upgradability () + ;; The names of the recognized defpackage forms. + (defparameter *defpackage-forms* '(defpackage define-package)) + + (defun initial-package-inferred-systems-table () + ;; Mark all existing packages are preloaded. + (let ((h (make-hash-table :test 'equal))) + (dolist (p (list-all-packages)) + (dolist (n (package-names p)) + (setf (gethash n h) t))) + h)) + + ;; Mapping from package names to systems that provide them. + (defvar *package-inferred-systems* (initial-package-inferred-systems-table)) + + (defclass package-inferred-system (system) + () + (:documentation "Class for primary systems for which secondary systems are automatically +in the one-file, one-file, one-system style: system names are mapped to files under the primary +system's system-source-directory, dependencies are inferred from the first defpackage form in +every such file")) + + ;; DEPRECATED. For backward compatibility only. To be removed in an upcoming release: + (defclass package-system (package-inferred-system) ()) + + ;; Is a given form recognizable as a defpackage form? + (defun defpackage-form-p (form) + (and (consp form) + (member (car form) *defpackage-forms*))) + + ;; Find the first defpackage form in a stream, if any + (defun stream-defpackage-form (stream) + (loop :for form = (read stream nil nil) :while form + :when (defpackage-form-p form) :return form)) + + (defun file-defpackage-form (file) + "Return the first DEFPACKAGE form in FILE." + (with-input-file (f file) + (stream-defpackage-form f))) + + (define-condition package-inferred-system-missing-package-error (system-definition-error) + ((system :initarg :system :reader error-system) + (pathname :initarg :pathname :reader error-pathname)) + (:report (lambda (c s) + (format s (compatfmt "~@<No package form found while ~ + trying to define package-inferred-system ~A from file ~A~>") + (error-system c) (error-pathname c))))) + + (defun package-dependencies (defpackage-form) + "Return a list of packages depended on by the package +defined in DEFPACKAGE-FORM. A package is depended upon if +the DEFPACKAGE-FORM uses it or imports a symbol from it." + (assert (defpackage-form-p defpackage-form)) + (remove-duplicates + (while-collecting (dep) + (loop* :for (option . arguments) :in (cddr defpackage-form) :do + (ecase option + ((:use :mix :reexport :use-reexport :mix-reexport) + (dolist (p arguments) (dep (string p)))) + ((:import-from :shadowing-import-from) + (dep (string (first arguments)))) + ((:nicknames :documentation :shadow :export :intern :unintern :recycle))))) + :from-end t :test 'equal)) + + (defun package-designator-name (package) + "Normalize a package designator to a string" + (etypecase package + (package (package-name package)) + (string package) + (symbol (string package)))) + + (defun register-system-packages (system packages) + "Register SYSTEM as providing PACKAGES." + (let ((name (or (eq system t) (coerce-name system)))) + (dolist (p (ensure-list packages)) + (setf (gethash (package-designator-name p) *package-inferred-systems*) name)))) + + (defun package-name-system (package-name) + "Return the name of the SYSTEM providing PACKAGE-NAME, if such exists, +otherwise return a default system name computed from PACKAGE-NAME." + (check-type package-name string) + (or (gethash package-name *package-inferred-systems*) + (string-downcase package-name))) + + ;; Given a file in package-inferred-system style, find its dependencies + (defun package-inferred-system-file-dependencies (file &optional system) + (if-let (defpackage-form (file-defpackage-form file)) + (remove t (mapcar 'package-name-system (package-dependencies defpackage-form))) + (error 'package-inferred-system-missing-package-error :system system :pathname file))) + + ;; Given package-inferred-system object, check whether its specification matches + ;; the provided parameters + (defun same-package-inferred-system-p (system name directory subpath around-compile dependencies) + (and (eq (type-of system) 'package-inferred-system) + (equal (component-name system) name) + (pathname-equal directory (component-pathname system)) + (equal dependencies (component-sideway-dependencies system)) + (equal around-compile (around-compile-hook system)) + (let ((children (component-children system))) + (and (length=n-p children 1) + (let ((child (first children))) + (and (eq (type-of child) 'cl-source-file) + (equal (component-name child) "lisp") + (and (slot-boundp child 'relative-pathname) + (equal (slot-value child 'relative-pathname) subpath)))))))) + ;; sysdef search function to push into *system-definition-search-functions* + (defun sysdef-package-inferred-system-search (system) + (let ((primary (primary-system-name system))) + (unless (equal primary system) + (let ((top (find-system primary nil))) + (when (typep top 'package-inferred-system) + (if-let (dir (component-pathname top)) + (let* ((sub (subseq system (1+ (length primary)))) + (f (probe-file* (subpathname dir sub :type "lisp") + :truename *resolve-symlinks*))) + (when (file-pathname-p f) + (let ((dependencies (package-inferred-system-file-dependencies f system)) + (previous (registered-system system)) + (around-compile (around-compile-hook top))) + (if (same-package-inferred-system-p previous system dir sub around-compile dependencies) + previous + (eval `(defsystem ,system + :class package-inferred-system + :source-file nil + :pathname ,dir + :depends-on ,dependencies + :around-compile ,around-compile + :components ((cl-source-file "lisp" :pathname ,sub))))))))))))))) + +(with-upgradability () + (pushnew 'sysdef-package-inferred-system-search *system-definition-search-functions*) + (setf *system-definition-search-functions* + (remove (find-symbol* :sysdef-package-system-search :asdf/package-system nil) + *system-definition-search-functions*))) ;;;; --------------------------------------------------------------------------- ;;;; asdf-output-translations @@ -11821,8 +12430,9 @@ effectively disabling the output translation facility." ;;;; See the Manual and https://bugs.launchpad.net/asdf/+bug/485918 (uiop/package:define-package :asdf/source-registry - (:recycle :asdf/source-registry :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system) + ;; NB: asdf/find-system allows upgrade from <=3.2.1 that have initialize-source-registry there + (:recycle :asdf/source-registry :asdf/find-system :asdf) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/system :asdf/system-registry) (:export #:*source-registry-parameter* #:*default-source-registries* #:invalid-source-registry @@ -12195,163 +12805,28 @@ after having found a .asd file? True by default.") ;;;; ------------------------------------------------------------------------- -;;;; Package systems in the style of quick-build or faslpath - -(uiop:define-package :asdf/package-inferred-system - (:recycle :asdf/package-inferred-system :asdf/package-system :asdf) - (:use :uiop/common-lisp :uiop - :asdf/defsystem ;; Using the old name of :asdf/parse-defsystem for compatibility - :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/lisp-action) - (:export - #:package-inferred-system #:sysdef-package-inferred-system-search - #:package-system ;; backward compatibility only. To be removed. - #:register-system-packages - #:*defpackage-forms* #:*package-inferred-systems* #:package-inferred-system-missing-package-error)) -(in-package :asdf/package-inferred-system) - -(with-upgradability () - ;; The names of the recognized defpackage forms. - (defparameter *defpackage-forms* '(defpackage define-package)) - - (defun initial-package-inferred-systems-table () - ;; Mark all existing packages are preloaded. - (let ((h (make-hash-table :test 'equal))) - (dolist (p (list-all-packages)) - (dolist (n (package-names p)) - (setf (gethash n h) t))) - h)) - - ;; Mapping from package names to systems that provide them. - (defvar *package-inferred-systems* (initial-package-inferred-systems-table)) - - (defclass package-inferred-system (system) - () - (:documentation "Class for primary systems for which secondary systems are automatically -in the one-file, one-file, one-system style: system names are mapped to files under the primary -system's system-source-directory, dependencies are inferred from the first defpackage form in -every such file")) - - ;; DEPRECATED. For backward compatibility only. To be removed in an upcoming release: - (defclass package-system (package-inferred-system) ()) - - ;; Is a given form recognizable as a defpackage form? - (defun defpackage-form-p (form) - (and (consp form) - (member (car form) *defpackage-forms*))) - - ;; Find the first defpackage form in a stream, if any - (defun stream-defpackage-form (stream) - (loop :for form = (read stream nil nil) :while form - :when (defpackage-form-p form) :return form)) - - (defun file-defpackage-form (file) - "Return the first DEFPACKAGE form in FILE." - (with-input-file (f file) - (stream-defpackage-form f))) - - (define-condition package-inferred-system-missing-package-error (system-definition-error) - ((system :initarg :system :reader error-system) - (pathname :initarg :pathname :reader error-pathname)) - (:report (lambda (c s) - (format s (compatfmt "~@<No package form found while ~ - trying to define package-inferred-system ~A from file ~A~>") - (error-system c) (error-pathname c))))) - - (defun package-dependencies (defpackage-form) - "Return a list of packages depended on by the package -defined in DEFPACKAGE-FORM. A package is depended upon if -the DEFPACKAGE-FORM uses it or imports a symbol from it." - (assert (defpackage-form-p defpackage-form)) - (remove-duplicates - (while-collecting (dep) - (loop* :for (option . arguments) :in (cddr defpackage-form) :do - (ecase option - ((:use :mix :reexport :use-reexport :mix-reexport) - (dolist (p arguments) (dep (string p)))) - ((:import-from :shadowing-import-from) - (dep (string (first arguments)))) - ((:nicknames :documentation :shadow :export :intern :unintern :recycle))))) - :from-end t :test 'equal)) - - (defun package-designator-name (package) - "Normalize a package designator to a string" - (etypecase package - (package (package-name package)) - (string package) - (symbol (string package)))) - - (defun register-system-packages (system packages) - "Register SYSTEM as providing PACKAGES." - (let ((name (or (eq system t) (coerce-name system)))) - (dolist (p (ensure-list packages)) - (setf (gethash (package-designator-name p) *package-inferred-systems*) name)))) - - (defun package-name-system (package-name) - "Return the name of the SYSTEM providing PACKAGE-NAME, if such exists, -otherwise return a default system name computed from PACKAGE-NAME." - (check-type package-name string) - (or (gethash package-name *package-inferred-systems*) - (string-downcase package-name))) - - ;; Given a file in package-inferred-system style, find its dependencies - (defun package-inferred-system-file-dependencies (file &optional system) - (if-let (defpackage-form (file-defpackage-form file)) - (remove t (mapcar 'package-name-system (package-dependencies defpackage-form))) - (error 'package-inferred-system-missing-package-error :system system :pathname file))) - - ;; Given package-inferred-system object, check whether its specification matches - ;; the provided parameters - (defun same-package-inferred-system-p (system name directory subpath around-compile dependencies) - (and (eq (type-of system) 'package-inferred-system) - (equal (component-name system) name) - (pathname-equal directory (component-pathname system)) - (equal dependencies (component-sideway-dependencies system)) - (equal around-compile (around-compile-hook system)) - (let ((children (component-children system))) - (and (length=n-p children 1) - (let ((child (first children))) - (and (eq (type-of child) 'cl-source-file) - (equal (component-name child) "lisp") - (and (slot-boundp child 'relative-pathname) - (equal (slot-value child 'relative-pathname) subpath)))))))) +;;; Internal hacks for backward-compatibility - ;; sysdef search function to push into *system-definition-search-functions* - (defun sysdef-package-inferred-system-search (system) - (let ((primary (primary-system-name system))) - (unless (equal primary system) - (let ((top (find-system primary nil))) - (when (typep top 'package-inferred-system) - (if-let (dir (component-pathname top)) - (let* ((sub (subseq system (1+ (length primary)))) - (f (probe-file* (subpathname dir sub :type "lisp") - :truename *resolve-symlinks*))) - (when (file-pathname-p f) - (let ((dependencies (package-inferred-system-file-dependencies f system)) - (previous (registered-system system)) - (around-compile (around-compile-hook top))) - (if (same-package-inferred-system-p previous system dir sub around-compile dependencies) - previous - (eval `(defsystem ,system - :class package-inferred-system - :source-file nil - :pathname ,dir - :depends-on ,dependencies - :around-compile ,around-compile - :components ((cl-source-file "lisp" :pathname ,sub))))))))))))))) +(uiop/package:define-package :asdf/backward-internals + (:recycle :asdf/backward-internals :asdf) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system) + (:export #:load-sysdef)) +(in-package :asdf/backward-internals) -(with-upgradability () - (pushnew 'sysdef-package-inferred-system-search *system-definition-search-functions*) - (setf *system-definition-search-functions* - (remove (find-symbol* :sysdef-package-system-search :asdf/package-system nil) - *system-definition-search-functions*))) +(with-asdf-deprecation (:style-warning "3.2" :warning "3.4") + (defun load-sysdef (name pathname) + (declare (ignore name pathname)) + ;; Needed for backward compatibility with swank-asdf from SLIME 2015-12-01 or older. + (error "Use asdf:load-asd instead of asdf::load-sysdef"))) ;;;; ------------------------------------------------------------------------- ;;; Backward-compatible interfaces (uiop/package:define-package :asdf/backward-interface (:recycle :asdf/backward-interface :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade - :asdf/component :asdf/system :asdf/find-system :asdf/operation :asdf/action - :asdf/lisp-action :asdf/plan :asdf/operate :asdf/output-translations) + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session + :asdf/component :asdf/system :asdf/system-registry :asdf/operation :asdf/action + :asdf/lisp-action :asdf/plan :asdf/operate + :asdf/find-system :asdf/parse-defsystem :asdf/output-translations :asdf/bundle) (:export #:*asdf-verbose* #:operation-error #:compile-error #:compile-failed #:compile-warned @@ -12361,13 +12836,14 @@ otherwise return a default system name computed from PACKAGE-NAME." #:operation-on-failure #:operation-on-warnings #:on-failure #:on-warnings #:component-property #:run-shell-command - #:system-definition-pathname - #:explain)) + #:system-definition-pathname #:system-registered-p #:require-system + #:explain + #+ecl #:make-build)) (in-package :asdf/backward-interface) ;; NB: the warning status of these functions may have to be distinguished later, ;; as some get removed faster than the others in client code. -(with-asdf-deprecation (:style-warning "3.2") +(with-asdf-deprecation (:style-warning "3.2" :warning "3.4") ;; These conditions from ASDF 1 and 2 are used by many packages in Quicklisp; ;; but ASDF3 replaced them with somewhat different variants of uiop:compile-condition @@ -12554,20 +13030,72 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) (define-convenience-action-methods explain (operation component))) (defmethod explain ((o operation) (c component)) (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))) -;;;; ------------------------------------------------------------------------- -;;; Internal hacks for backward-compatibility -(uiop/package:define-package :asdf/backward-internals - (:recycle :asdf/backward-internals :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system) - (:export #:load-sysdef)) -(in-package :asdf/backward-internals) +(with-asdf-deprecation (:style-warning "3.3") + (defun system-registered-p (name) + "DEPRECATED. Return a generalized boolean that is true if a system of given NAME was registered already. +NAME is a system designator, to be normalized by COERCE-NAME. +The value returned if true is a pair of a timestamp and a system object." + (if-let (system (registered-system name)) + (cons (if-let (primary-system (registered-system (primary-system-name name))) + (component-operation-time 'define-op primary-system)) + system))) -(with-asdf-deprecation (:style-warning "3.2") - (defun load-sysdef (name pathname) - (declare (ignore name pathname)) - ;; Needed for backward compatibility with swank-asdf from SLIME 2015-12-01 or older. - (error "Use asdf:load-asd instead of asdf::load-sysdef"))) + (defun require-system (system &rest keys &key &allow-other-keys) + "Ensure the specified SYSTEM is loaded, passing the KEYS to OPERATE, but do not update the +system or its dependencies if it has already been loaded." + (declare (ignore keys)) + (unless (component-loaded-p system) + (load-system system)))) + +;;; This function is for backward compatibility with ECL only. +#+ecl +(with-asdf-deprecation (:style-warning "3.2" :warning "9999") + (defun make-build (system &rest args + &key (monolithic nil) (type :fasl) (move-here nil move-here-p) + prologue-code epilogue-code no-uiop + prefix-lisp-object-files postfix-lisp-object-files extra-object-files + &allow-other-keys) + (let* ((operation (asdf/bundle::select-bundle-operation type monolithic)) + (move-here-path (if (and move-here + (typep move-here '(or pathname string))) + (ensure-pathname move-here :namestring :lisp :ensure-directory t) + (system-relative-pathname system "asdf-output/"))) + (extra-build-args (remove-plist-keys + '(:monolithic :type :move-here + :prologue-code :epilogue-code :no-uiop + :prefix-lisp-object-files :postfix-lisp-object-files + :extra-object-files) + args)) + (build-system (if (subtypep operation 'image-op) + (eval `(defsystem "asdf.make-build" + :class program-system + :source-file nil + :pathname ,(system-source-directory system) + :build-operation ,operation + :build-pathname ,(subpathname move-here-path + (file-namestring (first (output-files operation system)))) + :depends-on (,(coerce-name system)) + :prologue-code ,prologue-code + :epilogue-code ,epilogue-code + :no-uiop ,no-uiop + :prefix-lisp-object-files ,prefix-lisp-object-files + :postfix-lisp-object-files ,postfix-lisp-object-files + :extra-object-files ,extra-object-files + :extra-build-args ,extra-build-args)) + system)) + (files (output-files operation build-system))) + (operate operation build-system) + (if (or move-here + (and (null move-here-p) (member operation '(program-op image-op)))) + (loop :with dest-path = (resolve-symlinks* (ensure-directories-exist move-here-path)) + :for f :in files + :for new-f = (make-pathname :name (pathname-name f) + :type (pathname-type f) + :defaults dest-path) + :do (rename-file-overwriting-target f new-f) + :collect new-f) + files)))) ;;;; --------------------------------------------------------------------------- ;;;; Handle ASDF package upgrade, including implementation-dependent magic. @@ -12577,11 +13105,12 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) (:unintern #:loaded-systems ; makes for annoying SLIME completion #:output-files-for-system-and-operation) ; ASDF-BINARY-LOCATION function we use to detect ABL - (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache - :asdf/component :asdf/system :asdf/find-system :asdf/find-component + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session + :asdf/component :asdf/system :asdf/system-registry :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action :asdf/output-translations :asdf/source-registry - :asdf/plan :asdf/operate :asdf/parse-defsystem :asdf/bundle :asdf/concatenate-source + :asdf/forcing :asdf/plan :asdf/operate :asdf/find-system :asdf/parse-defsystem + :asdf/bundle :asdf/concatenate-source :asdf/backward-internals :asdf/backward-interface :asdf/package-inferred-system) ;; Note: (1) we are NOT automatically reexporting everything from previous packages. ;; (2) we only reexport UIOP functionality when backward-compatibility requires it. @@ -12597,13 +13126,14 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) #:non-propagating-operation #:build-op #:make #:load-op #:prepare-op #:compile-op - #:prepare-source-op #:load-source-op #:test-op + #:prepare-source-op #:load-source-op #:test-op #:define-op #:feature #:version #:version-satisfies #:upgrade-asdf #:implementation-identifier #:implementation-type #:hostname - #:input-files #:output-files #:output-file #:perform #:perform-with-restarts + #:component-depends-on ; backward-compatible name rather than action-depends-on + #:input-files #:additional-input-files + #:output-files #:output-file #:perform #:perform-with-restarts #:operation-done-p #:explain #:action-description #:component-sideway-dependencies #:needed-in-image-p - #:component-load-dependencies #:run-shell-command ; deprecated, do not use #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system #:program-system #:basic-compile-bundle-op #:prepare-bundle-op @@ -12621,20 +13151,15 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) #:operation-monolithic-p #:required-components #:component-loaded-p - #:component #:parent-component #:child-component #:system #:module #:file-component #:source-file #:c-source-file #:java-source-file #:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp #:static-file #:doc-file #:html-file #:file-type #:source-file-type - #:register-preloaded-system #:sysdef-preloaded-system-search #:register-immutable-system #:sysdef-immutable-system-search - #:package-inferred-system #:register-system-packages - #:package-system ;; backward-compatibility during migration, to be removed in a further release. - - #:component-children ; component accessors + #:component-children #:component-children-by-name #:component-pathname #:component-relative-pathname @@ -12644,13 +13169,6 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) #:component-system #:component-encoding #:component-external-format - - #:component-depends-on ; backward-compatible name rather than action-depends-on - #:module-components ; backward-compatibility - #:operation-on-warnings #:operation-on-failure ; backward-compatibility - #:component-property ; backward-compatibility - #:traverse ; backward-compatibility - #:system-description #:system-long-description #:system-author @@ -12669,20 +13187,15 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) #:system-defsystem-depends-on #:system-depends-on #:system-weakly-depends-on - #:*system-definition-search-functions* ; variables #:*central-registry* #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* #:*resolve-symlinks* - #:*asdf-verbose* ;; unused. For backward-compatibility only. #:*verbose-out* - #:asdf-version - #:compile-condition #:compile-file-error #:compile-warned-error #:compile-failed-error #:compile-warned-warning #:compile-failed-warning - #:operation-error #:compile-failed #:compile-warned #:compile-error ;; backward compatibility #:error-name #:error-pathname #:load-system-definition-error @@ -12693,23 +13206,19 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) #:missing-dependency #:missing-dependency-of-version #:circular-dependency ; errors - #:duplicate-names #:non-toplevel-system #:non-system-system #:bad-system-name + #:duplicate-names #:non-toplevel-system #:non-system-system #:bad-system-name #:system-out-of-date #:package-inferred-system-missing-package-error #:operation-definition-warning #:operation-definition-error - #:try-recompiling ; restarts #:retry #:accept #:coerce-entry-to-directory #:remove-entry-from-registry #:clear-configuration-and-retry - - #:*encoding-detection-hook* #:*encoding-external-format-hook* #:*default-encoding* #:*utf-8-external-format* - #:clear-configuration #:*output-translations-parameter* #:initialize-output-translations @@ -12728,7 +13237,7 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) #:clear-source-registry #:ensure-source-registry #:process-source-registry - #:system-registered-p #:registered-systems #:already-loaded-systems + #:registered-system #:registered-systems #:already-loaded-systems #:resolve-location #:asdf-message #:*user-cache* @@ -12740,8 +13249,14 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) #:system-source-registry #:user-source-registry-directory #:system-source-registry-directory - )) + ;; The symbols below are all DEPRECATED, do not use. To be removed in a further release. + #:*asdf-verbose* #:run-shell-command + #:component-load-dependencies #:system-registered-p #:package-system + #+ecl #:make-build + #:operation-on-warnings #:operation-on-failure #:operation-error + #:compile-failed #:compile-warned #:compile-error + #:module-components #:component-property #:traverse)) ;;;; --------------------------------------------------------------------------- ;;;; ASDF-USER, where the action happens. @@ -12759,7 +13274,8 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) (uiop/package:define-package :asdf/footer (:recycle :asdf/footer :asdf) (:use :uiop/common-lisp :uiop - :asdf/upgrade :asdf/find-system :asdf/operate :asdf/bundle) + :asdf/system ;; used by ECL + :asdf/upgrade :asdf/system-registry :asdf/operate :asdf/bundle) ;; Happily, all those implementations all have the same module-provider hook interface. #+(or abcl clasp cmucl clozure ecl mkcl sbcl) (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext @@ -12822,7 +13338,7 @@ DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) (setf excl:*warn-on-nested-reader-conditionals* uiop/common-lisp::*acl-warn-save*)) ;; Advertise the features we provide. - (dolist (f '(:asdf :asdf2 :asdf3 :asdf3.1 :asdf3.2 :asdf-package-system)) (pushnew f *features*)) + (dolist (f '(:asdf :asdf2 :asdf3 :asdf3.1 :asdf3.2 :asdf3.3)) (pushnew f *features*)) ;; Provide both lowercase and uppercase, to satisfy more people, especially LispWorks users. (provide "asdf") (provide "ASDF") diff --git a/src/contrib/asdf/doc/asdf.html b/src/contrib/asdf/doc/asdf.html index 8e85b2f6d8339af8d217b0c3d4679b3222b75641..46a1668a7bfc73282226b4a672a9331747ab2a34 100644 --- a/src/contrib/asdf/doc/asdf.html +++ b/src/contrib/asdf/doc/asdf.html @@ -31,7 +31,7 @@ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. --> -<!-- Created by GNU Texinfo 6.3, http://www.gnu.org/software/texinfo/ --> +<!-- Created by GNU Texinfo 6.1, http://www.gnu.org/software/texinfo/ --> <head> <title>ASDF Manual</title> @@ -235,6 +235,7 @@ ul.no-bullet {list-style: none} <ul class="no-bullet"> <li><a name="toc-_0060_0060My-Common-Lisp-implementation-comes-with-an-outdated-version-of-ASDF_002e-What-to-do_003f_0027_0027" href="#My-Common-Lisp-implementation-comes-with-an-outdated-version-of-ASDF_002e-What-to-do_003f">13.4.1 “My Common Lisp implementation comes with an outdated version of ASDF. What to do?”</a></li> <li><a name="toc-_0060_0060I_0027m-a-Common-Lisp-implementation-vendor_002e-When-and-how-should-I-upgrade-ASDF_003f_0027_0027" href="#I_0027m-a-Common-Lisp-implementation-vendor_002e-When-and-how-should-I-upgrade-ASDF_003f">13.4.2 “I’m a Common Lisp implementation vendor. When and how should I upgrade ASDF?”</a></li> + <li><a name="toc-After-upgrading-ASDF_002c-ASDF-_0028and-Quicklisp_0029-can_0027t-find-my-systems" href="#After-upgrading-ASDF">13.4.3 After upgrading ASDF, ASDF (and Quicklisp) can’t find my systems</a></li> </ul></li> <li><a name="toc-Issues-with-configuring-ASDF-1" href="#Issues-with-configuring-ASDF">13.5 Issues with configuring ASDF</a> <ul class="no-bullet"> @@ -276,7 +277,7 @@ ul.no-bullet {list-style: none} <a name="Top"></a> <a name="ASDF_003a-Another-System-Definition-Facility"></a> <h1 class="top">ASDF: Another System Definition Facility</h1> -<p>Manual for Version 3.2.1 +<p>Manual for Version 3.3.0 </p> <p>This manual describes ASDF, a system definition facility @@ -353,16 +354,19 @@ ASDF is <em>not</em> a tool for library and system <em>installation</em>; it plays a role like <code>make</code> or <code>ant</code>, not like a package manager. In particular, ASDF should not to be confused with Quicklisp or ASDF-Install, that attempt to find and download ASDF systems for you. -Despite what the name might suggest, ASDF-Install is not part of ASDF, but a separate piece of software. +Despite what the name might suggest, +ASDF-Install was never a part of ASDF, it was a separate piece of software. ASDF-Install is also unmaintained and obsolete. We recommend you use Quicklisp (<a href="http://www.quicklisp.org/">http://www.quicklisp.org/</a>) instead, a Common Lisp package manager which works well and is being actively maintained. If you want to download software from version control instead of tarballs, -so you may more easily modify it, we recommend clbuild (<a href="http://common-lisp.net/project/clbuild/">http://common-lisp.net/project/clbuild/</a>). -We recommend <samp>~/common-lisp/</samp> -as a place into which to install Common Lisp software; -starting with ASDF 3.1.2, it is included in the default source-registry configuration. +so you may more easily modify it, +we recommend clbuild (<a href="http://common-lisp.net/project/clbuild/">http://common-lisp.net/project/clbuild/</a>). +As for where on your filesystem to install Common Lisp software, +we recommend subdirectories of <samp>~/common-lisp/</samp>: +starting with ASDF 3.1.2 (2014), this hierarchy is included +in the default source-registry configuration. </p> <p>Finally, note that this manual is incomplete. All the bases are covered, @@ -511,8 +515,9 @@ before you contact us and raise an issue. <h3 class="section">3.3 Upgrading ASDF</h3> <p>If your implementation already provides ASDF 3 or later (and it should), -but you want a more recent ASDF version than your implementation provides, -then you just need to ensure the more recent ASDF is installed in a configured path, like any other system. +but you want a more recent ASDF version than your implementation provides, then +you just need to ensure the more recent ASDF is installed in a configured path, +like any other system. We recommend you download an official tarball or checkout a release from git into <samp>~/common-lisp/asdf/</samp>. (see <a href="#Configuring-ASDF-to-find-your-systems">Configuring ASDF to find your systems</a>). @@ -532,15 +537,18 @@ see <a href="#Replacing-your-implementation_0027s-ASDF">Replacing your implement <h3 class="section">3.4 Replacing your implementation’s ASDF</h3> <p>All maintained implementations now provide ASDF 3 in their latest release. -If your doesn’t, we recommend you upgrade it. +If yours doesn’t, we recommend you upgrade it. </p> -<p>Now, if you insist on using an old implementation that didn’t provide ASDF or provided an old version, +<p>Now, if you insist on using an old implementation +that didn’t provide ASDF or provided an old version, we recommend installing a recent ASDF, as explained below, into your implementation’s installation directory. Thus your modified implementation will now provide ASDF 3. -This requires proper write permissions and may necessitate execution as a system administrator. +This requires proper write permissions and +may necessitate execution as a system administrator. </p> -<p>The ASDF source repository contains a tool to help you upgrade your implementation’s ASDF. +<p>The ASDF source repository contains a tool to +help you upgrade your implementation’s ASDF. You can invoke it from the shell command-line as <code>tools/asdf-tools install-asdf lispworks</code> (where you can replace <code>lispworks</code> by the name of the relevant implementation), @@ -681,17 +689,34 @@ may already have configured system-managed libraries for you. <p>Novices may skip this section. +Please <em>do not</em> use the central-registry if you are a novice, +and <em>do not</em> instruct novices to use the central-registry. </p> <p>The old way to configure ASDF to find your systems is by <code>push</code>ing directory pathnames onto the variable <code>asdf:*central-registry*</code>. </p> -<p>You must configure this variable between the time you load ASDF -and the time you first try to use it. -Loading and configuring ASDF presumably happen -as part of some initialization script that builds or starts -your Common Lisp software system. -(For instance, some SBCL users used to put it in their <samp>~/.sbclrc</samp>.) +<p>You <em>must</em> configure this variable <em>after</em> you load ASDF 3 or later, +yet <em>before</em> the first time you try to use it. +This loading and configuring of ASDF must happen +as part of some initialization script: +typically, either a script you maintain that builds your project, +or your implementation’s initialization script +(e.g. <samp>~/.sbclrc</samp> for SBCL). +</p> +<p>Also, if you are using an ancient ASDF 2 or earlier to load ASDF 3 or later, +then after it loads the ancient ASDF, your script <em>must</em> configure +the central-registry a first time to tell ASDF 1 or 2 where to find ASDF 3, +then load ASDF 3 with e.g. <code>(asdf:operate 'asdf:load-op "asdf")</code>, +then configure the central-registry again, because +ASDF 3 will not preserve the central-registry from ASDF 2 when upgrading. +You should probably be using the source-registry instead, which will be preserved +(unless you manually called <code>asdf:initialize-source-registry</code> with an argument, +in which case you will have to do it again indeed). +However, if you are using an ancient ASDF 2 or earlier, +we <em>strongly</em> recommend that you should instead upgrade your implementation, +or overwrite the ancient ASDF installation with a more recent one: +See <a href="#Replacing-your-implementation_0027s-ASDF">Replacing your implementation's ASDF</a>. </p> <p>The <code>asdf:*central-registry*</code> is empty by default in ASDF 2 or ASDF 3, but is still supported for compatibility with ASDF 1. @@ -714,6 +739,8 @@ is necessary to tell Lisp that you’re discussing a directory rather than a file. If you leave it out, ASDF is likely to look in <code>/home/me/src/</code> instead of <code>/home/me/src/foo/</code> as you intended, and fail to find your system definition. +Modern versions of ASDF will issue an error and offer you to +remove such entries from the central-registry. </p> <p>Typically there are a lot of <samp>.asd</samp> files, and a common idiom was to put @@ -1309,6 +1336,12 @@ simple-component-name := string pathname-specifier := pathname | string | symbol +version-specifier := string + | (:read-file-form <pathname-specifier> <form-specifier>?) + | (:read-file-line <pathname-specifier> <line-specifier>?) +line-specifier := :at integer # base zero +form-specifier := :at [ integer | ( integer+ )] + method-form := (operation-name qual lambda-list &rest body) qual := method qualifier? @@ -1510,12 +1543,17 @@ had the version strings been interpreted as decimal fractions. the <code>:version</code> argument can be an expression that is resolved to such a string using the following trivial domain-specific language: in addition to being a literal string, it can be an expression of the form -<code>(:read-file-form <pathname-or-string> :at <access-at-specifier>)</code>, -which will be resolved by reading a form in the specified pathname -(read as a subpathname of the current system if relative or a unix-namestring). +<code>(:read-file-form <pathname-or-string> [:at <access-at-specifier]>)</code>, +or <code>(:read-file-line <pathname-or-string> [:at +<access-at-specifier]?>)</code>. +As the name suggests, the former will be resolved by reading a form in the specified pathname +(read as a subpathname of the current system if relative or a +unix-namestring), and the latter by reading a line. You may use a <code>uiop:access-at</code> specifier -with the (optional) <code>:at</code> keyword, -by default the specifier is <code>0</code>, meaning the first form is returned; +with the <code>:at</code> keyword, +by default the specifier is <code>0</code>, meaning the first form/line is +returned. +For <code>:read-file-form</code>, subforms can also be specified, with e.g. <code>(1 2 2)</code> specifying “the third subform (index 2) of the third subform (index 2) of the second form (index 1)” in the file (mind the off-by-one error in the English language). @@ -3486,7 +3524,7 @@ The speedup will only happen if the implementation-provided ASDF is recent enoug since the upgrade will itself be found but after the old version has scanned the directories without heeding such a cache. To upgrade the implementation-provided ASDF, -use our script <code>tools/install-asdf.lisp</code>. +see <a href="#Replacing-your-implementation_0027s-ASDF">Replacing your implementation's ASDF</a>. </p> <hr> @@ -5308,17 +5346,21 @@ Happily, CMUCL comes with a recent ASDF, and XCL is more of a working demo than something you’d use seriously anyway. </li><li> For the above reasons, your build and startup scripts -should load, configure and upgrade ASDF among the very first things they do, -and ensure that ASDF 3 or later is present indeed, -before they start using ASDF to load anything else. - -</li><li> Now that all implementations provide ASDF 3.1 or later (since May 2016), +should load ASDF 3, configure it, and upgrade it, +among the very first things they do. +They should ensure that only ASDF 3 or later is used indeed, +and error out if ASDF 2 or earlier was used. + +</li><li> Now that (since May 2016) all maintained implementations +(i.e. having had at least one release since 2014, +or a commit on their public source code repository) +provide ASDF 3.1 or later, the simple solution is just to use code as below in your setup, and when it fails, upgrade your implementation or replace its ASDF. (see <a href="#Replacing-your-implementation_0027s-ASDF">Replacing your implementation's ASDF</a>): <div class="example"> <pre class="example">(require "asdf") -#-asdf3 (error "ASDF 3 or bust") +#-asdf3.1 (error "ASDF 3.1 or bust") </pre></div> </li><li> For scripts that try to use ASDF simply via <code>require</code> at first, and @@ -5326,13 +5368,14 @@ make heroic attempts to load it the hard way if at first they don’t succee see <samp>tools/load-asdf.lisp</samp> distributed with the ASDF source repository, or the code of <a href="https://cliki.net/cl-launch"><code>cl-launch</code></a>. -</li><li> Note that in addition to the pitfalls and constraints above, +</li><li> <a name="reinitializeASDFAfterUpgrade"></a>Note that in addition to the pitfalls and constraints above, these heroic scripts (should you wish to write or modify one), must take care to configure ASDF <em>twice</em>. -A first time, right after you load the old ASDF 2 and before you upgrade to the new ASDF 3, +A first time, right after you load the old ASDF 2 (or 1!) +and before you upgrade to the new ASDF 3, so it may find where you put ASDF 3. -A second time, because some implementations can’t handle a smooth upgrade to ASDF 3, -and lose configuration as they do. +A second time, because most implementations can’t handle a smooth upgrade from ASDF 2 to ASDF 3, +so ASDF 3 doesn’t try (anymore) and loses any configuration from ASDF 2. <div class="lisp"> <pre class="lisp">(ignore-errors (funcall 'require "asdf")) ;; <--- try real hard ;; <--- insert heroics here, if that failed to provide ASDF 2 or 3 @@ -5486,7 +5529,38 @@ when they upgrade to the upstream version. </li></ul> - +<hr> +<a name="After-upgrading-ASDF"></a> +<a name="After-upgrading-ASDF_002c-ASDF-_0028and-Quicklisp_0029-can_0027t-find-my-systems"></a> +<h4 class="subsection">13.4.3 After upgrading ASDF, ASDF (and Quicklisp) can’t find my systems</h4> +<a name="index-_002acentral_002dregistry_002a"></a> +<a name="index-Quicklisp"></a> + +<p>When you upgrade the ASDF running in your Lisp image +from an ancient ASDF 2 or older to ASDF 3 or newer, +then you may have to re-configure ASDF. +If your configuration only consists in +using the source-registry and output-translations (as it should), +and if you are not explicitly calling <code>asdf:initialize-source-registry</code> +or <code>asdf:initialize-output-translations</code> with a non-nil argument, +then ASDF will reconfigure itself. +Otherwise, you will have to configure ASDF 2 (or older) to find ASDF 3, +then configure ASDF 3. +Notably, <var>*central-registry*</var> is not maintained across upgrades from ASDF 2. +See <a href="#reinitializeASDFAfterUpgrade">note about ASDF reconfiguration after upgrade</a>. +</p> +<p>Problems like this may be experienced if one loads Quicklisp +(which as of this writing bundles an obsolete ASDF version 2.26), +upgrades ASDF, and then tries to load new systems. +The correct solution is to load the most up-to-date ASDF you can, +<em>then</em> configure it, <em>then</em> load Quicklisp and any other extension. +Do <em>not</em> try to upgrade from ASDF 2 <em>after</em> loading Quicklisp, +for it will leave both ASDF and Quicklisp badly misconfigured. +For details see the discussion at the above cross-reference. +</p> +<p>Also, if you are experiencing such failures due to Quicklisp shipping an ancient ASDF, +please complain to Zach Beane about it. +</p> <hr> <a name="Issues-with-configuring-ASDF"></a> @@ -5884,24 +5958,17 @@ interested, too. ;; Load the test script support. (load "script-support.lisp") -;; Initialize the script support. -;; This will also change your *package* to asdf-test. +;; Initialize the script support for interaction. +;; This will also change your *package* to asdf-test +;; after frobbing the asdf-test package to make it usable. ;; NB: this function is also available from package cl-user, ;; and also available with the shorter name da in both packages. -(asdf-test::debug-asdf) - -;; In case you modified ASDF since you last tested it, -;; you need to update asdf.lisp itself by evaluating 'make' in a shell, -;; or (require "asdf") (asdf:load-system :asdf) in another CL REPL, -;; if not done in this REPL above. -;; *Then*, in this REPL, you need to evaluate: -;(asdf-test::compile-load-asdf) +(asdf-test:debug-asdf) ;; Now, you may experiment with test code from a .script file. ;; See the instructions given at the end of your failing test ;; to identify which form is needed, e.g. -(frob-packages) -(asdf::with-asdf-cache () (load "test-utilities.script")) +(run-test-script "test-utilities.script") </pre></div> @@ -6016,6 +6083,8 @@ see the <samp>TODO</samp> file in the source repository. <a class="summary-letter" href="#Concept-Index_cp_letter-P"><b>P</b></a> +<a class="summary-letter" href="#Concept-Index_cp_letter-Q"><b>Q</b></a> + <a class="summary-letter" href="#Concept-Index_cp_letter-R"><b>R</b></a> <a class="summary-letter" href="#Concept-Index_cp_letter-S"><b>S</b></a> @@ -6105,6 +6174,9 @@ see the <samp>TODO</samp> file in the source repository. <tr><td></td><td valign="top"><a href="#index-pathname-specifiers">pathname specifiers</a>:</td><td> </td><td valign="top"><a href="#The-defsystem-grammar">The defsystem grammar</a></td></tr> <tr><td></td><td valign="top"><a href="#index-Primary-system-name">Primary system name</a>:</td><td> </td><td valign="top"><a href="#Components">Components</a></td></tr> <tr><td colspan="4"> <hr></td></tr> +<tr><th><a name="Concept-Index_cp_letter-Q">Q</a></th><td></td><td></td></tr> +<tr><td></td><td valign="top"><a href="#index-Quicklisp">Quicklisp</a>:</td><td> </td><td valign="top"><a href="#After-upgrading-ASDF">After upgrading ASDF</a></td></tr> +<tr><td colspan="4"> <hr></td></tr> <tr><th><a name="Concept-Index_cp_letter-R">R</a></th><td></td><td></td></tr> <tr><td></td><td valign="top"><a href="#index-readtables">readtables</a>:</td><td> </td><td valign="top"><a href="#How-do-I-work-with-readtables_003f">How do I work with readtables?</a></td></tr> <tr><td colspan="4"> <hr></td></tr> @@ -6147,6 +6219,8 @@ see the <samp>TODO</samp> file in the source repository. <a class="summary-letter" href="#Concept-Index_cp_letter-P"><b>P</b></a> +<a class="summary-letter" href="#Concept-Index_cp_letter-Q"><b>Q</b></a> + <a class="summary-letter" href="#Concept-Index_cp_letter-R"><b>R</b></a> <a class="summary-letter" href="#Concept-Index_cp_letter-S"><b>S</b></a> @@ -6366,6 +6440,7 @@ see the <samp>TODO</samp> file in the source repository. <tr><td></td><th align="left">Index Entry</th><td> </td><th align="left"> Section</th></tr> <tr><td colspan="4"> <hr></td></tr> <tr><th><a name="Variable-Index_vr_symbol-1">*</a></th><td></td><td></td></tr> +<tr><td></td><td valign="top"><a href="#index-_002acentral_002dregistry_002a"><code>*central-registry*</code></a>:</td><td> </td><td valign="top"><a href="#After-upgrading-ASDF">After upgrading ASDF</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_002acompile_002dfile_002dfailure_002dbehaviour_002a"><code>*compile-file-failure-behaviour*</code></a>:</td><td> </td><td valign="top"><a href="#Error-handling">Error handling</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_002acompile_002dfile_002dwarnings_002dbehaviour_002a"><code>*compile-file-warnings-behaviour*</code></a>:</td><td> </td><td valign="top"><a href="#Error-handling">Error handling</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_002adefault_002dsource_002dregistry_002dexclusions_002a"><code>*default-source-registry-exclusions*</code></a>:</td><td> </td><td valign="top"><a href="#Search-Algorithm">Search Algorithm</a></td></tr> diff --git a/src/contrib/asdf/doc/asdf.info b/src/contrib/asdf/doc/asdf.info index c881a7017082c1234a61d6f22bc377ad2baf1855..976fb1b9797b85d2f99fc566c9714a9fe20837a5 100644 --- a/src/contrib/asdf/doc/asdf.info +++ b/src/contrib/asdf/doc/asdf.info @@ -1,4 +1,4 @@ -This is asdf.info, produced by makeinfo version 6.3 from asdf.texinfo. +This is asdf.info, produced by makeinfo version 6.1 from asdf.texinfo. This manual describes ASDF, a system definition facility for Common Lisp programs and libraries. @@ -43,7 +43,7 @@ File: asdf.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) ASDF: Another System Definition Facility **************************************** -Manual for Version 3.2.1 +Manual for Version 3.3.0 This manual describes ASDF, a system definition facility for Common Lisp programs and libraries. @@ -228,6 +228,7 @@ Issues with installing the proper version of ASDF * My Common Lisp implementation comes with an outdated version of ASDF. What to do?:: * I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?:: +* After upgrading ASDF, ASDF (and Quicklisp) can't find my systems: After upgrading ASDF. Issues with configuring ASDF @@ -276,16 +277,17 @@ ASDF::, for a description of the ASDF internals and how to extend ASDF. it plays a role like 'make' or 'ant', not like a package manager. In particular, ASDF should not to be confused with Quicklisp or ASDF-Install, that attempt to find and download ASDF systems for you. -Despite what the name might suggest, ASDF-Install is not part of ASDF, -but a separate piece of software. ASDF-Install is also unmaintained and -obsolete. We recommend you use Quicklisp (<http://www.quicklisp.org/>) -instead, a Common Lisp package manager which works well and is being -actively maintained. If you want to download software from version -control instead of tarballs, so you may more easily modify it, we -recommend clbuild (<http://common-lisp.net/project/clbuild/>). We -recommend '~/common-lisp/' as a place into which to install Common Lisp -software; starting with ASDF 3.1.2, it is included in the default -source-registry configuration. +Despite what the name might suggest, ASDF-Install was never a part of +ASDF, it was a separate piece of software. ASDF-Install is also +unmaintained and obsolete. We recommend you use Quicklisp +(<http://www.quicklisp.org/>) instead, a Common Lisp package manager +which works well and is being actively maintained. If you want to +download software from version control instead of tarballs, so you may +more easily modify it, we recommend clbuild +(<http://common-lisp.net/project/clbuild/>). As for where on your +filesystem to install Common Lisp software, we recommend subdirectories +of '~/common-lisp/': starting with ASDF 3.1.2 (2014), this hierarchy is +included in the default source-registry configuration. Finally, note that this manual is incomplete. All the bases are covered, but many advanced topics are only barely alluded to, and there @@ -446,7 +448,7 @@ File: asdf.info, Node: Replacing your implementation's ASDF, Next: Loading ASD ======================================== All maintained implementations now provide ASDF 3 in their latest -release. If your doesn't, we recommend you upgrade it. +release. If yours doesn't, we recommend you upgrade it. Now, if you insist on using an old implementation that didn't provide ASDF or provided an old version, we recommend installing a recent ASDF, @@ -612,16 +614,33 @@ File: asdf.info, Node: Configuring ASDF to find your systems --- old style, Ne 4.2 Configuring ASDF to find your systems -- old style ====================================================== -Novices may skip this section. +Novices may skip this section. Please _do not_ use the central-registry +if you are a novice, and _do not_ instruct novices to use the +central-registry. The old way to configure ASDF to find your systems is by 'push'ing directory pathnames onto the variable 'asdf:*central-registry*'. - You must configure this variable between the time you load ASDF and -the time you first try to use it. Loading and configuring ASDF -presumably happen as part of some initialization script that builds or -starts your Common Lisp software system. (For instance, some SBCL users -used to put it in their '~/.sbclrc'.) + You _must_ configure this variable _after_ you load ASDF 3 or later, +yet _before_ the first time you try to use it. This loading and +configuring of ASDF must happen as part of some initialization script: +typically, either a script you maintain that builds your project, or +your implementation's initialization script (e.g. '~/.sbclrc' for +SBCL). + + Also, if you are using an ancient ASDF 2 or earlier to load ASDF 3 or +later, then after it loads the ancient ASDF, your script _must_ +configure the central-registry a first time to tell ASDF 1 or 2 where to +find ASDF 3, then load ASDF 3 with e.g. '(asdf:operate 'asdf:load-op +"asdf")', then configure the central-registry again, because ASDF 3 will +not preserve the central-registry from ASDF 2 when upgrading. You +should probably be using the source-registry instead, which will be +preserved (unless you manually called 'asdf:initialize-source-registry' +with an argument, in which case you will have to do it again indeed). +However, if you are using an ancient ASDF 2 or earlier, we _strongly_ +recommend that you should instead upgrade your implementation, or +overwrite the ancient ASDF installation with a more recent one: *Note +Replacing your implementation's ASDF::. The 'asdf:*central-registry*' is empty by default in ASDF 2 or ASDF 3, but is still supported for compatibility with ASDF 1. When used, it @@ -640,7 +659,8 @@ pathname.(2) The trailing directory name separator is necessary to tell Lisp that you're discussing a directory rather than a file. If you leave it out, ASDF is likely to look in '/home/me/src/' instead of '/home/me/src/foo/' as you intended, and fail to find your system -definition. +definition. Modern versions of ASDF will issue an error and offer you +to remove such entries from the central-registry. Typically there are a lot of '.asd' files, and a common idiom was to put _symbolic links_ to all of one's '.asd' files in a common directory @@ -1214,6 +1234,12 @@ File: asdf.info, Node: The defsystem grammar, Next: Other code in .asd files, pathname-specifier := pathname | string | symbol + version-specifier := string + | (:read-file-form <pathname-specifier> <form-specifier>?) + | (:read-file-line <pathname-specifier> <line-specifier>?) + line-specifier := :at integer # base zero + form-specifier := :at [ integer | ( integer+ )] + method-form := (operation-name qual lambda-list &rest body) qual := method qualifier? @@ -1383,14 +1409,17 @@ happened had the version strings been interpreted as decimal fractions. can be an expression that is resolved to such a string using the following trivial domain-specific language: in addition to being a literal string, it can be an expression of the form '(:read-file-form -<pathname-or-string> :at <access-at-specifier>)', which will be resolved -by reading a form in the specified pathname (read as a subpathname of -the current system if relative or a unix-namestring). You may use a -'uiop:access-at' specifier with the (optional) ':at' keyword, by default -the specifier is '0', meaning the first form is returned; subforms can -also be specified, with e.g. '(1 2 2)' specifying "the third subform -(index 2) of the third subform (index 2) of the second form (index 1)" -in the file (mind the off-by-one error in the English language). +<pathname-or-string> [:at <access-at-specifier]>)', or '(:read-file-line +<pathname-or-string> [:at <access-at-specifier]?>)'. As the name +suggests, the former will be resolved by reading a form in the specified +pathname (read as a subpathname of the current system if relative or a +unix-namestring), and the latter by reading a line. You may use a +'uiop:access-at' specifier with the ':at' keyword, by default the +specifier is '0', meaning the first form/line is returned. For +':read-file-form', subforms can also be specified, with e.g. '(1 2 2)' +specifying "the third subform (index 2) of the third subform (index 2) +of the second form (index 1)" in the file (mind the off-by-one error in +the English language). System definers are encouraged to use version identifiers of the form X.Y.Z for major version, minor version and patch level, where @@ -3177,8 +3206,8 @@ speedup will only happen if the implementation-provided ASDF is recent enough (3.1.3.7 or later); it is not enough for a recent ASDF upgrade to be present, since the upgrade will itself be found but after the old version has scanned the directories without heeding such a cache. To -upgrade the implementation-provided ASDF, use our script -'tools/install-asdf.lisp'. +upgrade the implementation-provided ASDF, *note Replacing your +implementation's ASDF::. File: asdf.info, Node: Configuration API, Next: Introspection, Prev: Caching Results, Up: Controlling where ASDF searches for systems @@ -4866,17 +4895,19 @@ when upgrading from ASDF 2, due to limitations in ASDF 2. ASDF, and XCL is more of a working demo than something you'd use seriously anyway. - * For the above reasons, your build and startup scripts should load, - configure and upgrade ASDF among the very first things they do, and - ensure that ASDF 3 or later is present indeed, before they start - using ASDF to load anything else. - - * Now that all implementations provide ASDF 3.1 or later (since May - 2016), the simple solution is just to use code as below in your - setup, and when it fails, upgrade your implementation or replace - its ASDF. (*note Replacing your implementation's ASDF::): + * For the above reasons, your build and startup scripts should load + ASDF 3, configure it, and upgrade it, among the very first things + they do. They should ensure that only ASDF 3 or later is used + indeed, and error out if ASDF 2 or earlier was used. + + * Now that (since May 2016) all maintained implementations (i.e. + having had at least one release since 2014, or a commit on their + public source code repository) provide ASDF 3.1 or later, the + simple solution is just to use code as below in your setup, and + when it fails, upgrade your implementation or replace its ASDF. + (*note Replacing your implementation's ASDF::): (require "asdf") - #-asdf3 (error "ASDF 3 or bust") + #-asdf3.1 (error "ASDF 3.1 or bust") * For scripts that try to use ASDF simply via 'require' at first, and make heroic attempts to load it the hard way if at first they don't @@ -4887,10 +4918,11 @@ when upgrading from ASDF 2, due to limitations in ASDF 2. * Note that in addition to the pitfalls and constraints above, these heroic scripts (should you wish to write or modify one), must take care to configure ASDF _twice_. A first time, right after you load - the old ASDF 2 and before you upgrade to the new ASDF 3, so it may - find where you put ASDF 3. A second time, because some - implementations can't handle a smooth upgrade to ASDF 3, and lose - configuration as they do. + the old ASDF 2 (or 1!) and before you upgrade to the new ASDF 3, + so it may find where you put ASDF 3. A second time, because most + implementations can't handle a smooth upgrade from ASDF 2 to ASDF + 3, so ASDF 3 doesn't try (anymore) and loses any configuration from + ASDF 2. (ignore-errors (funcall 'require "asdf")) ;; <--- try real hard ;; <--- insert heroics here, if that failed to provide ASDF 2 or 3 ;; <--- insert configuration here, if that succeeded @@ -4937,6 +4969,7 @@ File: asdf.info, Node: Issues with installing the proper version of ASDF, Next * My Common Lisp implementation comes with an outdated version of ASDF. What to do?:: * I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?:: +* After upgrading ASDF, ASDF (and Quicklisp) can't find my systems: After upgrading ASDF. File: asdf.info, Node: My Common Lisp implementation comes with an outdated version of ASDF. What to do?, Next: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?, Prev: Issues with installing the proper version of ASDF, Up: Issues with installing the proper version of ASDF @@ -4954,7 +4987,7 @@ recommend you replace your implementation's ASDF. *Note Replacing your implementation's ASDF::. -File: asdf.info, Node: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?, Prev: My Common Lisp implementation comes with an outdated version of ASDF. What to do?, Up: Issues with installing the proper version of ASDF +File: asdf.info, Node: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?, Next: After upgrading ASDF, Prev: My Common Lisp implementation comes with an outdated version of ASDF. What to do?, Up: Issues with installing the proper version of ASDF 13.4.2 "I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?" ------------------------------------------------------------------------------------- @@ -5021,6 +5054,36 @@ should report upstream and that we will fix ASAP. can merge them back in for the benefit of your users when they upgrade to the upstream version. + +File: asdf.info, Node: After upgrading ASDF, Prev: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?, Up: Issues with installing the proper version of ASDF + +13.4.3 After upgrading ASDF, ASDF (and Quicklisp) can't find my systems +----------------------------------------------------------------------- + +When you upgrade the ASDF running in your Lisp image from an ancient +ASDF 2 or older to ASDF 3 or newer, then you may have to re-configure +ASDF. If your configuration only consists in using the source-registry +and output-translations (as it should), and if you are not explicitly +calling 'asdf:initialize-source-registry' or +'asdf:initialize-output-translations' with a non-nil argument, then ASDF +will reconfigure itself. Otherwise, you will have to configure ASDF 2 +(or older) to find ASDF 3, then configure ASDF 3. Notably, +*CENTRAL-REGISTRY* is not maintained across upgrades from ASDF 2. *Note +note about ASDF reconfiguration after upgrade: +reinitializeASDFAfterUpgrade. + + Problems like this may be experienced if one loads Quicklisp (which +as of this writing bundles an obsolete ASDF version 2.26), upgrades +ASDF, and then tries to load new systems. The correct solution is to +load the most up-to-date ASDF you can, _then_ configure it, _then_ load +Quicklisp and any other extension. Do _not_ try to upgrade from ASDF 2 +_after_ loading Quicklisp, for it will leave both ASDF and Quicklisp +badly misconfigured. For details see the discussion at the above +cross-reference. + + Also, if you are experiencing such failures due to Quicklisp shipping +an ancient ASDF, please complain to Zach Beane about it. + File: asdf.info, Node: Issues with configuring ASDF, Next: Issues with using and extending ASDF to define systems, Prev: Issues with installing the proper version of ASDF, Up: FAQ @@ -5403,24 +5466,17 @@ interested, too. ;; Load the test script support. (load "script-support.lisp") - ;; Initialize the script support. - ;; This will also change your *package* to asdf-test. + ;; Initialize the script support for interaction. + ;; This will also change your *package* to asdf-test + ;; after frobbing the asdf-test package to make it usable. ;; NB: this function is also available from package cl-user, ;; and also available with the shorter name da in both packages. - (asdf-test::debug-asdf) - - ;; In case you modified ASDF since you last tested it, - ;; you need to update asdf.lisp itself by evaluating 'make' in a shell, - ;; or (require "asdf") (asdf:load-system :asdf) in another CL REPL, - ;; if not done in this REPL above. - ;; *Then*, in this REPL, you need to evaluate: - ;(asdf-test::compile-load-asdf) + (asdf-test:debug-asdf) ;; Now, you may experiment with test code from a .script file. ;; See the instructions given at the end of your failing test ;; to identify which form is needed, e.g. - (frob-packages) - (asdf::with-asdf-cache () (load "test-utilities.script")) + (run-test-script "test-utilities.script") File: asdf.info, Node: Ongoing Work, Next: Bibliography, Prev: FAQ, Up: Top @@ -5511,34 +5567,34 @@ Concept Index * :asdf2: Introduction. (line 6) * :asdf3: Introduction. (line 6) * :build-operation: The defsystem grammar. - (line 128) + (line 134) * :compile-check: Controlling file compilation. (line 6) * :default-registry source config directive: Configuration DSL. (line 6) * :defsystem-depends-on: The defsystem grammar. - (line 120) + (line 126) * :directory source config directive: Configuration DSL. (line 6) * :exclude source config directive: Configuration DSL. (line 6) * :feature dependencies: The defsystem grammar. - (line 270) + (line 279) * :if-feature component option: The defsystem grammar. - (line 390) + (line 399) * :ignore-invalid-entries source config directive: Configuration DSL. (line 6) * :include source config directive: Configuration DSL. (line 6) * :inherit-configuration source config directive: Configuration DSL. (line 6) * :require dependencies: The defsystem grammar. - (line 260) + (line 269) * :tree source config directive: Configuration DSL. (line 6) * :version: The defsystem form. (line 68) * :version <1>: The defsystem grammar. - (line 229) + (line 235) * :version <2>: Common attributes of components. (line 23) * :weakly-depends-on: The defsystem grammar. - (line 140) + (line 146) * also-exclude source config directive: Configuration DSL. (line 6) * around-compile keyword: Controlling file compilation. (line 6) @@ -5579,23 +5635,25 @@ Concept Index * launchpad: Where do I report a bug?. (line 6) * logical pathnames: The defsystem grammar. - (line 289) + (line 298) * mailing list: Mailing list. (line 6) * operation: Operations. (line 6) * pathname specifiers: The defsystem grammar. - (line 162) + (line 168) * Primary system name: Components. (line 70) +* Quicklisp: After upgrading ASDF. + (line 6) * readtables: How do I work with readtables?. (line 6) * serial dependencies: The defsystem grammar. - (line 335) + (line 344) * system: Components. (line 6) * system designator: Components. (line 6) * System names: Components. (line 70) * Testing for ASDF: Introduction. (line 6) * tree source config directive: Configuration DSL. (line 6) * version specifiers: The defsystem grammar. - (line 229) + (line 235) File: asdf.info, Node: Function and Class Index, Next: Variable Index, Prev: Concept Index, Up: Top @@ -5776,6 +5834,8 @@ Variable Index �[index�] * Menu: +* *central-registry*: After upgrading ASDF. + (line 6) * *compile-file-failure-behaviour*: Error handling. (line 19) * *compile-file-warnings-behaviour*: Error handling. (line 19) * *default-source-registry-exclusions*: Search Algorithm. (line 6) @@ -5791,7 +5851,7 @@ Variable Index * *nil-pathname*: Some Utility Functions. (line 44) * *oldest-forward-compatible-asdf-version*: Pitfalls of the upgrade to ASDF 3. - (line 83) + (line 86) * *source-registry-parameter*: *source-registry-parameter* variable. (line 6) * *standard-output*: How can I capture ASDF's output?. @@ -5806,139 +5866,141 @@ Variable Index Tag Table: Node: Top1684 -Node: Introduction7706 -Node: Quick start summary10009 -Node: Loading ASDF11716 -Node: Loading a pre-installed ASDF12018 -Ref: Loading a pre-installed ASDF-Footnote-113831 -Node: Checking whether ASDF is loaded14013 -Node: Upgrading ASDF14927 -Node: Replacing your implementation's ASDF15915 -Node: Loading ASDF from source17338 -Node: Configuring ASDF18439 -Node: Configuring ASDF to find your systems19212 -Ref: Configuring ASDF to find your systems-Footnote-122517 -Ref: Configuring ASDF to find your systems-Footnote-222764 -Ref: Configuring ASDF to find your systems-Footnote-323046 -Node: Configuring ASDF to find your systems --- old style23507 -Ref: Configuring ASDF to find your systems --- old style-Footnote-125969 -Ref: Configuring ASDF to find your systems --- old style-Footnote-226201 -Ref: Configuring ASDF to find your systems --- old style-Footnote-326968 -Node: Configuring where ASDF stores object files27124 -Node: Resetting the ASDF configuration28527 -Node: Using ASDF29584 -Node: Loading a system29795 -Node: Convenience Functions30812 -Ref: Convenience Functions-Footnote-136172 -Node: Moving on36250 -Node: Defining systems with defsystem36621 -Node: The defsystem form37049 -Node: A more involved example40455 -Ref: A more involved example-Footnote-147437 -Node: The defsystem grammar48119 -Ref: if-feature-option65617 -Node: Other code in .asd files67160 -Node: The package-inferred-system extension68296 -Node: The object model of ASDF72563 -Ref: The object model of ASDF-Footnote-174894 -Ref: The object model of ASDF-Footnote-275246 -Node: Operations75573 -Ref: operate76678 -Ref: make-operation79414 -Node: Predefined operations of ASDF79835 -Ref: test-op81949 -Node: Creating new operations89838 -Node: Components95051 -Ref: System names98535 -Ref: Components-Footnote-1103207 -Ref: Components-Footnote-2103503 -Node: Common attributes of components103825 -Ref: required-features105387 -Node: Pre-defined subclasses of component111234 -Node: Creating new component types113668 -Node: Dependencies114958 -Node: Functions116829 -Node: Controlling where ASDF searches for systems118663 -Node: Configurations119285 -Node: Truenames and other dangers122760 -Node: XDG base directory124046 -Node: Backward Compatibility125460 -Node: Configuration DSL126176 -Node: Configuration Directories131731 -Node: The here directive133558 -Node: Shell-friendly syntax for configuration135451 -Node: Search Algorithm136468 -Node: Caching Results138338 -Node: Configuration API141582 -Node: Introspection143621 -Node: *source-registry-parameter* variable143885 -Node: Information about system dependencies144454 -Node: Status145370 -Node: Rejected ideas145825 -Node: TODO148206 -Node: Credits for the source-registry148391 -Node: Controlling where ASDF saves compiled files148926 -Ref: Controlling where ASDF saves compiled files-Footnote-1150338 -Node: Output Configurations150382 -Ref: Output Configurations-Footnote-1153243 -Node: Output Backward Compatibility153309 -Node: Output Configuration DSL156035 -Node: Output Configuration Directories161490 -Node: Output Shell-friendly syntax for configuration163047 -Node: Semantics of Output Translations164566 -Node: Output Caching Results166135 -Node: Output location API166615 -Node: Credits for output translations169037 -Node: Error handling169557 -Node: Miscellaneous additional functionality170398 -Node: Controlling file compilation170870 -Node: Controlling source file character encoding174136 -Node: Miscellaneous Functions180953 -Ref: system-relative-pathname181250 -Ref: Miscellaneous Functions-Footnote-1187697 -Node: Some Utility Functions187808 -Node: Getting the latest version198586 -Node: FAQ199531 -Node: Where do I report a bug?199926 -Node: Mailing list200291 -Node: What has changed between ASDF 1 ASDF 2 and ASDF 3?200626 -Node: What are ASDF 1 2 3?202800 -Node: How do I detect the ASDF version?203841 -Node: ASDF can portably name files in subdirectories206148 -Node: Output translations207698 -Node: Source Registry Configuration208725 -Node: Usual operations are made easier to the user210352 -Node: Many bugs have been fixed210938 -Node: ASDF itself is versioned212770 -Node: ASDF can be upgraded213645 -Node: Decoupled release cycle214797 -Node: Pitfalls of the transition to ASDF 2215726 -Node: Pitfalls of the upgrade to ASDF 3219996 -Ref: Pitfalls of the upgrade to ASDF 3-Footnote-1224365 -Node: What happened to the bundle operations224535 -Node: Issues with installing the proper version of ASDF225700 -Node: My Common Lisp implementation comes with an outdated version of ASDF. What to do?226171 -Node: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?227104 -Node: Issues with configuring ASDF230987 -Node: How can I customize where fasl files are stored?231362 -Node: How can I wholly disable the compiler output cache?232455 -Node: Issues with using and extending ASDF to define systems233834 -Node: How can I cater for unit-testing in my system?234631 -Node: How can I cater for documentation generation in my system?235519 -Node: How can I maintain non-Lisp (e.g. C) source files?236040 -Ref: report-bugs236472 -Node: I want to put my module's files at the top level. How do I do this?236472 -Node: How do I create a system definition where all the source files have a .cl extension?239622 -Node: How do I mark a source file to be loaded only and not compiled?241595 -Node: How do I work with readtables?242591 -Node: How can I capture ASDF's output?246318 -Node: LOAD-PATHNAME has a weird value246789 -Node: ASDF development FAQs248275 -Node: How do I run the tests interactively in a REPL?248514 -Node: Ongoing Work250380 -Node: Bibliography250659 -Node: Concept Index254130 -Node: Function and Class Index260989 -Node: Variable Index272763 +Node: Introduction7796 +Node: Quick start summary10155 +Node: Loading ASDF11862 +Node: Loading a pre-installed ASDF12164 +Ref: Loading a pre-installed ASDF-Footnote-113977 +Node: Checking whether ASDF is loaded14159 +Node: Upgrading ASDF15073 +Node: Replacing your implementation's ASDF16061 +Node: Loading ASDF from source17485 +Node: Configuring ASDF18586 +Node: Configuring ASDF to find your systems19359 +Ref: Configuring ASDF to find your systems-Footnote-122664 +Ref: Configuring ASDF to find your systems-Footnote-222911 +Ref: Configuring ASDF to find your systems-Footnote-323193 +Node: Configuring ASDF to find your systems --- old style23654 +Ref: Configuring ASDF to find your systems --- old style-Footnote-127258 +Ref: Configuring ASDF to find your systems --- old style-Footnote-227490 +Ref: Configuring ASDF to find your systems --- old style-Footnote-328257 +Node: Configuring where ASDF stores object files28413 +Node: Resetting the ASDF configuration29816 +Node: Using ASDF30873 +Node: Loading a system31084 +Node: Convenience Functions32101 +Ref: Convenience Functions-Footnote-137461 +Node: Moving on37539 +Node: Defining systems with defsystem37910 +Node: The defsystem form38338 +Node: A more involved example41744 +Ref: A more involved example-Footnote-148726 +Node: The defsystem grammar49408 +Ref: if-feature-option67366 +Node: Other code in .asd files68909 +Node: The package-inferred-system extension70045 +Node: The object model of ASDF74312 +Ref: The object model of ASDF-Footnote-176643 +Ref: The object model of ASDF-Footnote-276995 +Node: Operations77322 +Ref: operate78427 +Ref: make-operation81163 +Node: Predefined operations of ASDF81584 +Ref: test-op83698 +Node: Creating new operations91587 +Node: Components96800 +Ref: System names100284 +Ref: Components-Footnote-1104956 +Ref: Components-Footnote-2105252 +Node: Common attributes of components105574 +Ref: required-features107136 +Node: Pre-defined subclasses of component112983 +Node: Creating new component types115417 +Node: Dependencies116707 +Node: Functions118578 +Node: Controlling where ASDF searches for systems120412 +Node: Configurations121034 +Node: Truenames and other dangers124509 +Node: XDG base directory125795 +Node: Backward Compatibility127209 +Node: Configuration DSL127925 +Node: Configuration Directories133480 +Node: The here directive135307 +Node: Shell-friendly syntax for configuration137200 +Node: Search Algorithm138217 +Node: Caching Results140087 +Node: Configuration API143335 +Node: Introspection145374 +Node: *source-registry-parameter* variable145638 +Node: Information about system dependencies146207 +Node: Status147123 +Node: Rejected ideas147578 +Node: TODO149959 +Node: Credits for the source-registry150144 +Node: Controlling where ASDF saves compiled files150679 +Ref: Controlling where ASDF saves compiled files-Footnote-1152091 +Node: Output Configurations152135 +Ref: Output Configurations-Footnote-1154996 +Node: Output Backward Compatibility155062 +Node: Output Configuration DSL157788 +Node: Output Configuration Directories163243 +Node: Output Shell-friendly syntax for configuration164800 +Node: Semantics of Output Translations166319 +Node: Output Caching Results167888 +Node: Output location API168368 +Node: Credits for output translations170790 +Node: Error handling171310 +Node: Miscellaneous additional functionality172151 +Node: Controlling file compilation172623 +Node: Controlling source file character encoding175889 +Node: Miscellaneous Functions182706 +Ref: system-relative-pathname183003 +Ref: Miscellaneous Functions-Footnote-1189450 +Node: Some Utility Functions189561 +Node: Getting the latest version200339 +Node: FAQ201284 +Node: Where do I report a bug?201679 +Node: Mailing list202044 +Node: What has changed between ASDF 1 ASDF 2 and ASDF 3?202379 +Node: What are ASDF 1 2 3?204553 +Node: How do I detect the ASDF version?205594 +Node: ASDF can portably name files in subdirectories207901 +Node: Output translations209451 +Node: Source Registry Configuration210478 +Node: Usual operations are made easier to the user212105 +Node: Many bugs have been fixed212691 +Node: ASDF itself is versioned214523 +Node: ASDF can be upgraded215398 +Node: Decoupled release cycle216550 +Node: Pitfalls of the transition to ASDF 2217479 +Node: Pitfalls of the upgrade to ASDF 3221749 +Ref: reinitializeASDFAfterUpgrade225451 +Ref: Pitfalls of the upgrade to ASDF 3-Footnote-1226323 +Node: What happened to the bundle operations226493 +Node: Issues with installing the proper version of ASDF227658 +Node: My Common Lisp implementation comes with an outdated version of ASDF. What to do?228219 +Node: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?229152 +Node: After upgrading ASDF233064 +Node: Issues with configuring ASDF234715 +Node: How can I customize where fasl files are stored?235090 +Node: How can I wholly disable the compiler output cache?236183 +Node: Issues with using and extending ASDF to define systems237562 +Node: How can I cater for unit-testing in my system?238359 +Node: How can I cater for documentation generation in my system?239247 +Node: How can I maintain non-Lisp (e.g. C) source files?239768 +Ref: report-bugs240200 +Node: I want to put my module's files at the top level. How do I do this?240200 +Node: How do I create a system definition where all the source files have a .cl extension?243350 +Node: How do I mark a source file to be loaded only and not compiled?245323 +Node: How do I work with readtables?246319 +Node: How can I capture ASDF's output?250046 +Node: LOAD-PATHNAME has a weird value250517 +Node: ASDF development FAQs252003 +Node: How do I run the tests interactively in a REPL?252242 +Node: Ongoing Work253809 +Node: Bibliography254088 +Node: Concept Index257559 +Node: Function and Class Index264554 +Node: Variable Index276328 End Tag Table diff --git a/src/contrib/asdf/doc/asdf.pdf b/src/contrib/asdf/doc/asdf.pdf index d1a670e03df6fcae074400dd8685a95c7e14e793..a27a7e5fe941d873719d906af339da81dc2df4b2 100644 Binary files a/src/contrib/asdf/doc/asdf.pdf and b/src/contrib/asdf/doc/asdf.pdf differ