diff --git a/Makefile b/Makefile index 3f32b62590fbe751f5bc2f25a8ae010d7fd7090a..3a08155917a3ac237ac88a8e816db35b59274d74 100644 --- a/Makefile +++ b/Makefile @@ -152,13 +152,13 @@ test-all-upgrade-no-stop: @for lisp in ${lisps} ; do ${MAKE} test-upgrade l=$$lisp ; done ; : test-all-no-upgrade-no-stop: doc test-load-systems test-all-clean-load test-all-lisp-no-stop - make check-all-test-results + make --quiet check-all-test-results test-all-no-stop: doc test-load-systems test-all-clean-load test-all-lisp-no-stop test-all-upgrade-no-stop - make check-all-results + make --quiet check-all-results check-all-test-results: - @A="`grep -L '49 passing and 0 failing' build/results/*-test.text`" ; \ + @A="`grep -L '[5-9][0-9] passing and 0 failing' build/results/*-test.text`" ; \ if [ -n "$$A" ] ; then \ echo "Unexpected test failures on these implementations:" ; \ echo "$$A" ; \ diff --git a/TODO b/TODO index b1f354ebede3963c86eaf2d8244fee27acad798c..d5fc898ab1837cbee092db4aa00f69f06dab1f3c 100644 --- a/TODO +++ b/TODO @@ -74,6 +74,8 @@ rather than nil. This is probably a bug in #+ processing. Unhappily, debian creates such a file in /etc/common-lisp/asdf-output-translations.conf.d/01-common-lisp-controller.conf + * Tests that try to catch an error fail (but catching a warning succeeds), + which suggests brokenness in handler-bind and/or error. * Some out-of-line configuration mechanism for various options? i.e. let configuration files override some variables around compilation of some systems. @@ -136,6 +138,33 @@ * operation cleanup? ** Kill backward-compat functions after all clients have moved on. ** Kill original-initargs -- BEWARE, it currently has clients! +** To allow semantically distinct operations of the same class: +You'd need to have a protocol to canonicalize them +in the *OPERATIONS* memoization table, not by class name, +but by CONS of the class name and some CANONICAL-OPERATION-INITARGS. +The latter would be a generic function called on the initargs, +where any parasite initargs such as FORCE and FORCE-NOT have been removed, +since they below to the PLAN, not the OPERATION: +the OPERATE protocol would be refined to explicit split +arguments to be passed to MAKE-PLAN or to MAKE-OPERATION. +The default method for CANONICAL-OPERATION-INITARGS +would SORT (a plist->alist of) the initargs, +and that would replace the current ORIGINAL-INITARGS slot. +For this scheme to work even in presence of undisciplined users +using MAKE-INSTANCE on an operation class, +the OPERATION class would have an extra slot EFFECTIVE-OPERATION, +uninitialized by default (nil or unbound), whose accessor initializes it +if it's uninitialized, by looking up a canonical instance in *OPERATIONS*, +and if unfound registering the current operation as canonical. +Then, each component's COMPONENT-OPERATION-TIME hash-table +would be indexed by canonicalized operation object +rather than by operation class, +and POIU would have to be changed accordingly. +Of course, this entire cleanup is incompatible +with how SWANK and GBBopen currently abuse slots of operation, +so these would have to be fixed first. +And that's why I didn't do it. +It looks like SWANK can be fixed soon, though, so we'll see. * Get rid of component-properties ** directly use component-properties: @@ -214,3 +243,5 @@ * ASDF4: search for this tag, rename things (incompatibly, thus) and cleanup code. +* See message from 2014-01-27 05:26:44 GMT for stuff to document. + http://thread.gmane.org/gmane.lisp.asdf.devel/3675/focus=3695 diff --git a/action.lisp b/action.lisp index 842e6b891f42910bf3568d31073d1e5c02407bf7..a10019945748526c4dc00897c12b89b0c899d24a 100644 --- a/action.lisp +++ b/action.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Actions -(asdf/package:define-package :asdf/action +(uiop/package:define-package :asdf/action (:nicknames :asdf-action) (:recycle :asdf/action :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade @@ -17,8 +17,8 @@ #:perform #:perform-with-restarts #:retry #:accept #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan #:action-path #:find-action #:stamp #:done-p - ;; condition - #:operation-definition-error + #:operation-definition-warning #:operation-definition-error ;; condition + #:build-op ;; THE generic operation )) (in-package :asdf/action) @@ -134,10 +134,7 @@ You can put together sentences using this phrase.")) (defmethod component-depends-on :around ((o operation) (c component)) (do-asdf-cache `(component-depends-on ,o ,c) - (call-next-method))) - - (defmethod component-depends-on ((o operation) (c component)) - (cdr (assoc (type-of o) (component-in-order-to c))))) ; User-specified in-order dependencies + (call-next-method)))) ;;;; upward-operation, downward-operation, sideway-operation, selfward-operation @@ -153,8 +150,10 @@ the action (O . M) of O on module M will depends on each of (D . C) for each chi The default value for slot DOWNWARD-OPERATION is NIL, which designates the operation O itself. E.g. in order for a MODULE to be loaded with LOAD-OP (resp. compiled with COMPILE-OP), all the children of the MODULE must have been loaded with LOAD-OP (resp. compiled with COMPILE-OP.")) + (defun downward-operation-depends-on (o c) + `((,(or (downward-operation o) o) ,@(component-children c)))) (defmethod component-depends-on ((o downward-operation) (c parent-component)) - `((,(or (downward-operation o) o) ,@(component-children c)) ,@(call-next-method))) + `(,@(downward-operation-depends-on o c) ,@(call-next-method))) (defclass upward-operation (operation) ((upward-operation @@ -168,9 +167,10 @@ E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPA must first be prepared for loading or compiling with PREPARE-OP.")) ;; For backward-compatibility reasons, a system inherits from module and is a child-component ;; so we must guard against this case. ASDF4: remove that. + (defun upward-operation-depends-on (o c) + (if-let (p (component-parent c)) `((,(or (upward-operation o) o) ,p)))) (defmethod component-depends-on ((o upward-operation) (c child-component)) - `(,@(if-let (p (component-parent c)) - `((,(or (upward-operation o) o) ,p))) ,@(call-next-method))) + `(,@(upward-operation-depends-on o c) ,@(call-next-method))) (defclass sideway-operation (operation) ((sideway-operation @@ -182,11 +182,12 @@ designates operation S (where NIL designates O itself), then the action (O . C) depends on each of (S . D) where D is a declared dependency of C. E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPARE-OP, each of its declared dependencies must first be loaded as by LOAD-OP.")) - (defmethod component-depends-on ((o sideway-operation) (c component)) + (defun sideway-operation-depends-on (o c) `((,(or (sideway-operation o) o) ,@(loop :for dep :in (component-sideway-dependencies c) - :collect (resolve-dependency-spec c dep))) - ,@(call-next-method))) + :collect (resolve-dependency-spec c dep))))) + (defmethod component-depends-on ((o sideway-operation) (c component)) + `(,@(sideway-operation-depends-on o c) ,@(call-next-method))) (defclass selfward-operation (operation) ((selfward-operation @@ -201,14 +202,14 @@ a list of operation-designators designates the list of designated operations; NIL is not a valid operation designator in that context. Note that orderings between the operations in a list of SELWARD-OPERATION should be indicated separately in order that they be scheduled properly.")) + (defun selfward-operation-depends-on (o c) + (loop :for op :in (ensure-list (selfward-operation o)) :collect `(,op ,c))) (defmethod component-depends-on ((o selfward-operation) (c component)) - `(,@(loop :for op :in (ensure-list (selfward-operation o)) - :collect `(,op ,c)) - ,@(call-next-method))) + `(,@(selfward-operation-depends-on o c) ,@(call-next-method))) (defclass non-propagating-operation (operation) () - (:documentation "A NON-PROPAGATING-OPERATION is an operation that propagates + (:documentation "A NON-PROPAGATING-OPERATION is an operation that propagates no dependencies whatsoever. It is supplied in order that the programmer be able to specify that s/he is intentionally specifying an operation which invokes no dependencies."))) @@ -217,37 +218,47 @@ dependencies."))) ;;;--------------------------------------------------------------------------- ;;; Help programmers catch obsolete OPERATION subclasses ;;;--------------------------------------------------------------------------- -(define-condition operation-definition-error (simple-error) - () - (:documentation "Error conditions related to incorrect definitions of -OPERATION objects.")) -(defmethod initialize-instance :before ((obj operation) &key) - (unless - (loop :for x :in '(downward-operation upward-operation sideway-operation - selfward-operation non-propagating-operation - ;; the following is a special case - build-op) - :when (typep obj x) - :return t - :finally (return nil)) - (error 'operation-definition-error - :format-control - "No dependency propagating scheme specified for operation ~a. This is likely because the OPERATION subclass of this object has not been updated for ASDF 3." - :format-arguments (list obj)))) - -(defmethod initialize-instance :before ((obj non-propagating-operation) &key) - (when - (loop :for x :in '(downward-operation upward-operation sideway-operation - selfward-operation) - :when (typep obj x) - :return t - :finally (return nil)) - (error 'operation-definition-error - :format-control - "Inconsistent class: ~a. No class should have both NON-PROPAGATING-OPERATION and a propagating operation class as superclasses." - :format-arguments - (list - (class-name (class-of obj)))))) +(with-upgradability () + (define-condition operation-definition-warning (simple-warning) + () + (:documentation "Warning condition related to definition of obsolete OPERATION objects.")) + + (define-condition operation-definition-error (simple-error) + () + (:documentation "Error condition related to definition of incorrect OPERATION objects.")) + + (defmethod initialize-instance :before ((o operation) &key) + ;; build-op is a special case. + (unless (typep o '(or downward-operation upward-operation sideway-operation + selfward-operation non-propagating-operation)) + (warn 'operation-definition-warning + :format-control + "No dependency propagating scheme specified for operation class ~S. +The class needs to be updated for ASDF 3.1 and specify appropriate propagation mixins." + :format-arguments (list (type-of o))))) + + (defmethod initialize-instance :before ((o non-propagating-operation) &key) + (when (typep o '(or downward-operation upward-operation sideway-operation selfward-operation)) + (error 'operation-definition-error + :format-control + "Inconsistent class: ~S + NON-PROPAGATING-OPERATION is incompatible with propagating operation classes as superclasses." + :format-arguments + (list (type-of o))))) + + (defmethod component-depends-on ((o operation) (c component)) + `(;; Normal behavior, to allow user-specified in-order-to dependencies + ,@(cdr (assoc (type-of o) (component-in-order-to c))) + ;; For backward-compatibility with ASDF2, any operation that doesn't specify propagation + ;; or non-propagation through an appropriate mixin will be downward and sideway. + ,@(unless (typep o '(or downward-operation upward-operation sideway-operation + selfward-operation non-propagating-operation)) + `(,@(downward-operation-depends-on o c) + ,@(sideway-operation-depends-on o c))))) + + (defmethod downward-operation ((o operation)) nil) + (defmethod sideway-operation ((o operation)) nil)) + ;;;--------------------------------------------------------------------------- ;;; End of OPERATION class checking @@ -265,7 +276,6 @@ OPERATION objects.")) (define-convenience-action-methods operation-done-p (operation component)) (defmethod operation-done-p ((o operation) (c component)) - (declare (ignorable o c)) t) (defmethod output-files :around (operation component) @@ -287,7 +297,6 @@ OPERATION objects.")) (mapcar *output-translation-function* absolute-pathnames)))) t))) (defmethod output-files ((o operation) (c component)) - (declare (ignorable o c)) nil) (defun output-file (operation component) "The unique output file of performing OPERATION on COMPONENT" @@ -301,7 +310,6 @@ OPERATION objects.")) (call-next-method))) (defmethod input-files ((o operation) (c component)) - (declare (ignorable o c)) nil) (defmethod input-files ((o selfward-operation) (c component)) @@ -367,7 +375,6 @@ in some previous image, or T if it needs to be done.") (defmethod perform :after ((o operation) (c component)) (mark-operation-done o c)) (defmethod perform ((o operation) (c parent-component)) - (declare (ignorable o c)) nil) (defmethod perform ((o operation) (c source-file)) (sysdef-error @@ -398,6 +405,12 @@ in some previous image, or T if it needs to be done.") ;;; Generic build operation (with-upgradability () + ;; build op was intended to be the master, default operation on a system + ;; (LOAD-OP typically serves that function now). This feature has not yet + ;; been fully implemented yet. + ;; This is a path forward, but is not backwardly compatible, and is not used + ;; yet. [2014/01/26:rpg] + (defclass build-op (non-propagating-operation) ()) (defmethod component-depends-on ((o build-op) (c component)) `((,(or (component-build-operation c) 'load-op) ,c)))) diff --git a/asdf.asd b/asdf.asd index 01dc0588fd6936579609f683d0332a9817f7103d..ed1d257a16626212373a495b85e018469ea3be55 100644 --- a/asdf.asd +++ b/asdf.asd @@ -75,7 +75,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.1.0.54" ;; to be automatically updated by make bump-version + :version "3.1.0.60" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 :class #.(if (find-class 'package-system nil) 'package-system 'system) diff --git a/backward-interface.lisp b/backward-interface.lisp index 30c11caec6a0ed3bf155a85a3c26f09600d94b17..cce317e43e35cd531624fa8a0f8ff608499570ff 100644 --- a/backward-interface.lisp +++ b/backward-interface.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;; Backward-compatible interfaces -(asdf/package:define-package :asdf/backward-interface +(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 @@ -43,13 +43,13 @@ (defgeneric (setf operation-on-warnings) (x operation)) (defgeneric (setf operation-on-failure) (x operation)) (defmethod operation-on-warnings ((o operation)) - (declare (ignorable o)) *compile-file-warnings-behaviour*) + *compile-file-warnings-behaviour*) (defmethod operation-on-failure ((o operation)) - (declare (ignorable o)) *compile-file-failure-behaviour*) + *compile-file-failure-behaviour*) (defmethod (setf operation-on-warnings) (x (o operation)) - (declare (ignorable o)) (setf *compile-file-warnings-behaviour* x)) + (setf *compile-file-warnings-behaviour* x)) (defmethod (setf operation-on-failure) (x (o operation)) - (declare (ignorable o)) (setf *compile-file-failure-behaviour* x)) + (setf *compile-file-failure-behaviour* x)) (defun system-definition-pathname (x) ;; As of 2.014.8, we mean to make this function obsolete, @@ -119,7 +119,7 @@ processed in order by OPERATE.")) :ignore-inherited-configuration)))) (defmethod operate :before (operation-class system &rest args &key &allow-other-keys) - (declare (ignorable operation-class system args)) + (declare (ignore operation-class system args)) (when (find-symbol* '#:output-files-for-system-and-operation :asdf nil) (error "ASDF 2 is not compatible with ASDF-BINARY-LOCATIONS, which you are using. ASDF 2 now achieves the same purpose with its builtin ASDF-OUTPUT-TRANSLATIONS, diff --git a/backward-internals.lisp b/backward-internals.lisp index 07e39c6a02ea344fac678dc83629429221f79bf0..4eeb97319185659026525bb100b3a420b15e8e74 100644 --- a/backward-internals.lisp +++ b/backward-internals.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;; Internal hacks for backward-compatibility -(asdf/package:define-package :asdf/backward-internals +(uiop/package:define-package :asdf/backward-internals (:recycle :asdf/backward-internals :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/system :asdf/component :asdf/operation diff --git a/bundle.lisp b/bundle.lisp index d68d378c6cf2b59d4de8bf990886b939ecbe5f54..7dbb9c5c573368b351ccf0b05f475f1610c703f3 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; ASDF-Bundle -(asdf/package:define-package :asdf/bundle +(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 @@ -163,7 +163,7 @@ itself.")) ;; operation on a system and its dependencies (defmethod initialize-instance :after ((instance bundle-op) &rest initargs &key (name-suffix nil name-suffix-p) &allow-other-keys) - (declare (ignorable initargs name-suffix)) + (declare (ignore initargs name-suffix)) (unless name-suffix-p (setf (slot-value instance 'name-suffix) (unless (typep instance 'program-op) @@ -184,7 +184,6 @@ itself.")) ;; operation on a system and its dependencies (operation-original-initargs instance)))) (defmethod bundle-op-build-args :around ((o no-ld-flags-op)) - (declare (ignorable o)) (let ((args (call-next-method))) (remf args :ld-flags) args)) @@ -229,7 +228,6 @@ itself.")) ;; operation on a system and its dependencies ,@(call-next-method))) (defmethod component-depends-on :around ((o bundle-op) (c component)) - (declare (ignorable o c)) (if-let (op (and (eq (type-of o) 'bundle-op) (component-build-operation c))) `((,op ,c)) (call-next-method))) @@ -291,7 +289,6 @@ itself.")) ;; operation on a system and its dependencies ;;; (with-upgradability () (defmethod component-depends-on ((o load-fasl-op) (c system)) - (declare (ignorable o)) `((,o ,@(loop :for dep :in (component-sideway-dependencies c) :collect (resolve-dependency-spec c dep))) (,(if (user-system-p c) 'fasl-op 'load-op) ,c) @@ -301,10 +298,6 @@ itself.")) ;; operation on a system and its dependencies (when (user-system-p c) (output-files (find-operation o 'fasl-op) c))) - (defmethod perform ((o load-fasl-op) c) - (declare (ignorable o c)) - nil) - (defmethod perform ((o load-fasl-op) (c system)) (when (input-files o c) (perform-lisp-load-fasl o c))) @@ -322,11 +315,7 @@ itself.")) ;; operation on a system and its dependencies (defmethod trivial-system-p ((s system)) (every #'(lambda (c) (typep c 'compiled-file)) (component-children s))) - (defmethod output-files (o (c compiled-file)) - (declare (ignorable o c)) - nil) - (defmethod input-files (o (c compiled-file)) - (declare (ignorable o)) + (defmethod input-files ((o operation) (c compiled-file)) (component-pathname c)) (defmethod perform ((o load-op) (c compiled-file)) (perform-lisp-load-fasl o c)) @@ -335,7 +324,6 @@ itself.")) ;; operation on a system and its dependencies (defmethod perform ((o load-fasl-op) (c compiled-file)) (perform (find-operation o 'load-op) c)) (defmethod perform ((o operation) (c compiled-file)) - (declare (ignorable o c)) nil)) ;;; @@ -343,19 +331,15 @@ itself.")) ;; operation on a system and its dependencies ;;; (with-upgradability () (defmethod trivial-system-p ((s prebuilt-system)) - (declare (ignorable s)) t) (defmethod perform ((o lib-op) (c prebuilt-system)) - (declare (ignorable o c)) nil) (defmethod component-depends-on ((o lib-op) (c prebuilt-system)) - (declare (ignorable o c)) nil) (defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system)) - (declare (ignorable o)) nil)) @@ -428,14 +412,12 @@ itself.")) ;; operation on a system and its dependencies (combine-fasls fasl-files output-file))))) (defmethod input-files ((o load-op) (s precompiled-system)) - (declare (ignorable o)) (bundle-output-files (find-operation o 'fasl-op) s)) (defmethod perform ((o load-op) (s precompiled-system)) (perform-lisp-load-fasl o s)) (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system)) - (declare (ignorable o)) `((load-op ,s) ,@(call-next-method)))) #| ;; Example use: @@ -502,8 +484,9 @@ itself.")) ;; operation on a system and its dependencies #+(and (not asdf-use-unsafe-mac-bundle-op) (or (and ecl darwin) (and abcl darwin))) -(defmethod perform :before ((op basic-fasl-op) c) - (declare (ignorable op c)) - (unless (uiop:featurep :asdf-use-unsafe-mac-bundle-op) +(defmethod perform :before ((o basic-fasl-op) (c component)) + (unless (featurep :asdf-use-unsafe-mac-bundle-op) (cerror "Continue after modifying *FEATURES*." - "BASIC-FASL-OP bundle operations are not supported on Mac OSX for this lisp.~%~TTo continue, push :asdf-use-unsafe-mac-bundle-op on *FEATURES*.~%~TPlease report to ASDF-DEVEL if this works for you."))) + "BASIC-FASL-OP bundle operations are not supported on Mac OS X for this lisp.~%~T~ +To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~ +Please report to ASDF-DEVEL if this works for you."))) diff --git a/cache.lisp b/cache.lisp index eb5754342dca7ee23bf5cfb4b47978ff9e7cc662..4ca218f4eb50b8f6a2e370980960dfe095a46d21 100644 --- a/cache.lisp +++ b/cache.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Stamp cache -(asdf/package:define-package :asdf/cache +(uiop/package:define-package :asdf/cache (:use :uiop/common-lisp :uiop :asdf/upgrade) (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp #:consult-asdf-cache #:do-asdf-cache #:normalize-namestring diff --git a/component.lisp b/component.lisp index f8a5f26a767901f38362b9a258155455074a3048..f129b105a3f1612d124d8cfe8a37bf58f6af1dae 100644 --- a/component.lisp +++ b/component.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Components -(asdf/package:define-package :asdf/component +(uiop/package:define-package :asdf/component (:recycle :asdf/component :asdf/defsystem :asdf/find-system :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade) (:export @@ -61,7 +61,7 @@ another pathname in a degenerate way.")) (defgeneric component-version (component)) (defgeneric (setf component-version) (new-version component)) (defgeneric component-parent (component)) - (defmethod component-parent ((component null)) (declare (ignorable component)) nil) + (defmethod component-parent ((component null)) nil) ;; Backward compatible way of computing the FILE-TYPE of a component. ;; TODO: find users, have them stop using that, remove it for ASDF4. @@ -83,11 +83,6 @@ another pathname in a degenerate way.")) (duplicate-names-name c)))))) - -(when-upgrading (:when (find-class 'component nil)) - (defmethod reinitialize-instance :after ((c component) &rest initargs &key) - (declare (ignorable c initargs)) (values))) - (with-upgradability () (defclass component () ((name :accessor component-name :initarg :name :type string :documentation @@ -194,9 +189,9 @@ a PARENT-COMPONENT.")) (default-component-class :initform nil :initarg :default-component-class - :accessor module-default-component-class))) + :accessor module-default-component-class)) (:documentation "A PARENT-COMPONENT is a component that may have -children.")) +children."))) (with-upgradability () (defun compute-children-by-name (parent &key only-if-needed-p) @@ -210,19 +205,6 @@ children.")) (setf (gethash name hash) c)) hash)))) -(when-upgrading (:when (find-class 'module nil)) - (defmethod reinitialize-instance :after ((m module) &rest initargs &key) - (declare (ignorable m initargs)) (values)) - (defmethod update-instance-for-redefined-class :after - ((m module) added deleted plist &key) - (declare (ignorable m added deleted plist)) - (when (and (member 'children added) (member 'components deleted)) - (setf (slot-value m 'children) - ;; old ECLs provide an alist instead of a plist(!) - (if (or #+ecl (consp (first plist))) (or #+ecl (cdr (assoc 'components plist))) - (getf plist 'components))) - (compute-children-by-name m)))) - (with-upgradability () (defclass module (child-component parent-component) (#+clisp (components)))) ;; backward compatibility during upgrade only @@ -248,9 +230,10 @@ children.")) pathname))) (defmethod component-relative-pathname ((component component)) - ;; source-file-type is backward-compatibility with ASDF1; - ;; we ought to be able to extract this from the component alone with COMPONENT-TYPE. - ;; TODO: track who uses it, and have them not use it anymore. + ;; SOURCE-FILE-TYPE below is strictly for backward-compatibility with ASDF1. + ;; We ought to be able to extract this from the component alone with COMPONENT-TYPE. + ;; TODO: track who uses it, and have them not use it anymore; + ;; maybe issue a WARNING (then eventually CERROR) if the two methods diverge? (parse-unix-namestring (or (and (slot-boundp component 'relative-pathname) (slot-value component 'relative-pathname)) @@ -259,12 +242,10 @@ children.")) :type (source-file-type component (component-system component)) :defaults (component-parent-pathname component))) - (defmethod source-file-type ((component parent-component) system) - (declare (ignorable component system)) + (defmethod source-file-type ((component parent-component) (system parent-component)) :directory) - (defmethod source-file-type ((component file-component) system) - (declare (ignorable system)) + (defmethod source-file-type ((component file-component) (system parent-component)) (file-type component))) diff --git a/concatenate-source.lisp b/concatenate-source.lisp index 53323872955863f0cd36a656dc523188cfbcedb7..3c7258dad6ff8c04917cb17dcb05e6dbd20b53dc 100644 --- a/concatenate-source.lisp +++ b/concatenate-source.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Concatenate-source -(asdf/package:define-package :asdf/concatenate-source +(uiop/package:define-package :asdf/concatenate-source (:recycle :asdf/concatenate-source :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/operation diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index b954fb4d1dd2a4d341ed6ef1e49772842e5814ac..0f66a0c033d29d62b948bffe0f76397110a211e5 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -35,11 +35,11 @@ for Common Lisp programs and libraries. You can find the latest version of this manual at @url{http://common-lisp.net/project/asdf/asdf.html}. -ASDF Copyright @copyright{} 2001-2013 Daniel Barlow and contributors. +ASDF Copyright @copyright{} 2001-2014 Daniel Barlow and contributors. -This manual Copyright @copyright{} 2001-2013 Daniel Barlow and contributors. +This manual Copyright @copyright{} 2001-2014 Daniel Barlow and contributors. -This manual revised @copyright{} 2009-2013 Robert P. Goldman and Francois-Rene Rideau. +This manual revised @copyright{} 2009-2014 Robert P. Goldman and Francois-Rene Rideau. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the @@ -173,7 +173,7 @@ the ASDF internals and how to extend ASDF. @emph{Nota Bene}: We have released ASDF 2.000 on May 31st 2010, -and ASDF 3.0 on January 31st 2013. +and ASDF 3.0.0 on May 15th 2013. Releases of ASDF 2 and later have since then been included in all actively maintained CL implementations that used to bundle ASDF 1, plus some implementations that didn't use to, diff --git a/find-component.lisp b/find-component.lisp index 98f3928623d5e8b9454a412002425d2a8e94e5f0..89108aedc702347518c181bb2fae558e9d52780c 100644 --- a/find-component.lisp +++ b/find-component.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Finding components -(asdf/package:define-package :asdf/find-component +(uiop/package:define-package :asdf/find-component (:recycle :asdf/find-component :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/system :asdf/find-system) @@ -79,8 +79,7 @@ (defmethod find-component ((c component) (name cons)) (find-component (find-component c (car name)) (cdr name))) - (defmethod find-component (base (actual component)) - (declare (ignorable base)) + (defmethod find-component ((base t) (actual component)) actual) (defun resolve-dependency-name (component name &optional version) @@ -120,11 +119,9 @@ (cons combinator arguments) component)) (defmethod resolve-dependency-combination (component (combinator (eql :feature)) arguments) - (declare (ignorable combinator)) (when (featurep (first arguments)) (resolve-dependency-spec component (second arguments)))) (defmethod resolve-dependency-combination (component (combinator (eql :version)) arguments) - (declare (ignorable combinator)) ;; See https://bugs.launchpad.net/asdf/+bug/527788 - (resolve-dependency-name component (first arguments) (second arguments)))) + (resolve-dependency-name component (first arguments) (second arguments)))) ;; See lp#527788 diff --git a/find-system.lisp b/find-system.lisp index 84d53d27536e84fcbfa6a7233c78387b5d19f65f..c0e6012f50c995f2437a7d48f68cbd3fa1de51a6 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Finding systems -(asdf/package:define-package :asdf/find-system +(uiop/package:define-package :asdf/find-system (:recycle :asdf/find-system :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/system :asdf/cache) @@ -246,7 +246,6 @@ Going forward, we recommend new users should be using the source-registry. (register-preloaded-system s :version *asdf-version*)) (defmethod find-system ((name null) &optional (error-p t)) - (declare (ignorable name)) (when error-p (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>")))) diff --git a/footer.lisp b/footer.lisp index b0828343b4c84612ba328b09684ded85896e96b3..692415b9fe1955c269371fc1dae0bcee7f46dfac 100644 --- a/footer.lisp +++ b/footer.lisp @@ -1,7 +1,7 @@ ;;;; ----------------------------------------------------------------------- ;;;; ASDF Footer: last words and cleanup -(asdf/package:define-package :asdf/footer +(uiop/package:define-package :asdf/footer (:recycle :asdf/footer :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/operate :asdf/bundle)) (in-package :asdf/footer) diff --git a/header.lisp b/header.lisp index aab3bb91107a1b4e177e74076103552716000d0b..fc21f003f9f4f05ab6d1aa512f5c2c98d1258d08 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 3.1.0.54: Another System Definition Facility. +;;; This is ASDF 3.1.0.60: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/interface.lisp b/interface.lisp index d2e860fdbffeca6f0af85cb171c7610d48fa2afb..b92a120260d5ff824e2f78513c006e22ba8c1f02 100644 --- a/interface.lisp +++ b/interface.lisp @@ -1,7 +1,7 @@ ;;;; --------------------------------------------------------------------------- ;;;; Handle ASDF package upgrade, including implementation-dependent magic. -(asdf/package:define-package :asdf/interface +(uiop/package:define-package :asdf/interface (:nicknames :asdf :asdf-utilities) (:recycle :asdf/interface :asdf) (:unintern @@ -121,7 +121,7 @@ #:circular-dependency ; errors #:duplicate-names #:non-toplevel-system #:non-system-system #:package-system-missing-package-error - #:operation-definition-error + #:operation-definition-warning #:operation-definition-error #:try-recompiling #:retry diff --git a/lisp-action.lisp b/lisp-action.lisp index d4ce3626228960cfd4d2a3ae25ab2c8c4a21b74a..1e435867f4dc19a5306e863c9cf1886386f2cd91 100644 --- a/lisp-action.lisp +++ b/lisp-action.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Actions to build Common Lisp software -(asdf/package:define-package :asdf/lisp-action +(uiop/package:define-package :asdf/lisp-action (:recycle :asdf/lisp-action :asdf) (:intern #:proclamations #:flags) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache @@ -41,13 +41,12 @@ ((sideway-operation :initform 'load-op :allocation :class)) (:documentation "Load the necessary dependencies for the COMPONENT to which we apply the PREPARE-OP.")) - (defclass load-op (basic-load-op downward-operation sideway-operation selfward-operation) + (defclass load-op (basic-load-op downward-operation selfward-operation) ;; NB: even though compile-op depends on prepare-op it is not needed-in-image-p, ;; so we need to directly depend on prepare-op for its side-effects in the current image. ((selfward-operation :initform '(prepare-op compile-op) :allocation :class))) (defclass compile-op (basic-compile-op downward-operation selfward-operation) - ((selfward-operation :initform 'prepare-op :allocation :class) - (downward-operation :initform 'load-op :allocation :class))) + ((selfward-operation :initform 'prepare-op :allocation :class))) (defclass prepare-source-op (upward-operation sideway-operation) ((sideway-operation :initform 'load-source-op :allocation :class))) @@ -63,25 +62,17 @@ the PREPARE-OP.")) ;;; prepare-op (with-upgradability () (defmethod action-description ((o prepare-op) (c component)) - (declare (ignorable o)) (format nil (compatfmt "~@<loading dependencies of ~3i~_~A~@:>") c)) (defmethod perform ((o prepare-op) (c component)) - (declare (ignorable o c)) - nil) - (defmethod input-files ((o prepare-op) (c component)) - (declare (ignorable o c)) nil) (defmethod input-files ((o prepare-op) (s system)) - (declare (ignorable o)) (if-let (it (system-source-file s)) (list it)))) ;;; compile-op (with-upgradability () (defmethod action-description ((o compile-op) (c component)) - (declare (ignorable o)) (format nil (compatfmt "~@<compiling ~3i~_~A~@:>") c)) (defmethod action-description ((o compile-op) (c parent-component)) - (declare (ignorable o)) (format nil (compatfmt "~@<completing compilation for ~3i~_~A~@:>") c)) (defgeneric call-with-around-compile-hook (component thunk)) (defmethod call-with-around-compile-hook ((c component) function) @@ -147,10 +138,6 @@ the PREPARE-OP.")) (defmethod output-files ((o compile-op) (c cl-source-file)) (lisp-compilation-output-files o c)) (defmethod perform ((o compile-op) (c static-file)) - (declare (ignorable o c)) - nil) - (defmethod output-files ((o compile-op) (c static-file)) - (declare (ignorable o c)) nil) (defmethod perform ((o compile-op) (c system)) (when (and *warnings-file-type* (not (builtin-system-p c))) @@ -170,15 +157,11 @@ the PREPARE-OP.")) ;;; load-op (with-upgradability () (defmethod action-description ((o load-op) (c cl-source-file)) - (declare (ignorable o)) (format nil (compatfmt "~@<loading FASL for ~3i~_~A~@:>") c)) (defmethod action-description ((o load-op) (c parent-component)) - (declare (ignorable o)) (format nil (compatfmt "~@<completing load for ~3i~_~A~@:>") c)) - (defmethod action-description ((o load-op) component) - (declare (ignorable o)) - (format nil (compatfmt "~@<loading ~3i~_~A~@:>") - component)) + (defmethod action-description ((o load-op) (c component)) + (format nil (compatfmt "~@<loading ~3i~_~A~@:>") c)) (defmethod perform-with-restarts ((o load-op) (c cl-source-file)) (loop (restart-case @@ -194,7 +177,6 @@ the PREPARE-OP.")) (defmethod perform ((o load-op) (c cl-source-file)) (perform-lisp-load-fasl o c)) (defmethod perform ((o load-op) (c static-file)) - (declare (ignorable o c)) nil)) @@ -203,25 +185,17 @@ the PREPARE-OP.")) ;;; prepare-source-op (with-upgradability () (defmethod action-description ((o prepare-source-op) (c component)) - (declare (ignorable o)) (format nil (compatfmt "~@<loading source for dependencies of ~3i~_~A~@:>") c)) - (defmethod input-files ((o prepare-source-op) (c component)) - (declare (ignorable o c)) - nil) (defmethod input-files ((o prepare-source-op) (s system)) - (declare (ignorable o)) (if-let (it (system-source-file s)) (list it))) (defmethod perform ((o prepare-source-op) (c component)) - (declare (ignorable o c)) nil)) ;;; load-source-op (with-upgradability () - (defmethod action-description ((o load-source-op) c) - (declare (ignorable o)) + (defmethod action-description ((o load-source-op) (c component)) (format nil (compatfmt "~@<Loading source of ~3i~_~A~@:>") c)) (defmethod action-description ((o load-source-op) (c parent-component)) - (declare (ignorable o)) (format nil (compatfmt "~@<Loaded source of ~3i~_~A~@:>") c)) (defun perform-lisp-load-source (o c) (call-with-around-compile-hook @@ -232,20 +206,14 @@ the PREPARE-OP.")) (defmethod perform ((o load-source-op) (c cl-source-file)) (perform-lisp-load-source o c)) (defmethod perform ((o load-source-op) (c static-file)) - (declare (ignorable o c)) - nil) - (defmethod output-files ((o load-source-op) (c component)) - (declare (ignorable o c)) nil)) ;;;; test-op (with-upgradability () (defmethod perform ((o test-op) (c component)) - (declare (ignorable o c)) nil) (defmethod operation-done-p ((o test-op) (c system)) "Testing a system is _never_ done." - (declare (ignorable o c)) nil)) diff --git a/operate.lisp b/operate.lisp index a4b42762c01d4e52086fcb394eba800d9938f2c2..b91ddb23c02e3e74b498b1ce3ba2602d1be85d85 100644 --- a/operate.lisp +++ b/operate.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Invoking Operations -(asdf/package:define-package :asdf/operate +(uiop/package:define-package :asdf/operate (:recycle :asdf/operate :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/system :asdf/operation :asdf/action @@ -53,7 +53,6 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: &key verbose (on-warnings *compile-file-warnings-behaviour*) (on-failure *compile-file-failure-behaviour*) &allow-other-keys) - (declare (ignorable operation component)) (let* ((systems-being-operated *systems-being-operated*) (*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal))) (operation-name (reify-symbol (etypecase operation @@ -160,18 +159,15 @@ for how to load or compile stuff") ((module :initarg :module :initform nil :accessor required-module))) (defmethod perform ((o compile-op) (c require-system)) - (declare (ignorable o c)) nil) (defmethod perform ((o load-op) (s require-system)) - (declare (ignorable o)) (let* ((module (or (required-module s) (coerce-name s))) (*modules-being-required* (cons module *modules-being-required*))) (assert (null (component-children s))) (require module))) (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments) - (declare (ignorable component combinator)) (unless (length=n-p arguments 1) (error (compatfmt "~@<Bad dependency ~S for ~S. ~S takes only one argument~@:>") (cons combinator arguments) component combinator)) diff --git a/operation.lisp b/operation.lisp index 41fbacbc4795c7cc31e38daa422752eb30687e61..d2e38a64459de4b3b145a6c15f3a23984318be9e 100644 --- a/operation.lisp +++ b/operation.lisp @@ -1,21 +1,21 @@ ;;;; ------------------------------------------------------------------------- ;;;; Operations -(asdf/package:define-package :asdf/operation +(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) (:export #:operation #:operation-original-initargs #:original-initargs ;; backward-compatibility only. DO NOT USE. - #:build-op ;; THE generic operation #:*operations* #:make-operation #:find-operation #:feature)) (in-package :asdf/operation) ;;; Operation Classes (when-upgrading (:when (find-class 'operation nil)) - (defmethod shared-initialize :after ((o operation) slot-names &rest initargs &key) - (declare (ignorable o slot-names initargs)) (values))) + ;; 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 () @@ -26,7 +26,7 @@ ;; already bound. (defmethod initialize-instance :after ((o operation) &rest initargs &key force force-not system verbose &allow-other-keys) - (declare (ignorable force force-not system verbose)) + (declare (ignore force force-not system verbose)) (unless (slot-boundp o 'original-initargs) (setf (operation-original-initargs o) initargs))) @@ -46,8 +46,7 @@ (defgeneric find-operation (context spec) (:documentation "Find an operation by resolving the SPEC in the CONTEXT")) - (defmethod find-operation (context (spec operation)) - (declare (ignorable context)) + (defmethod find-operation ((context t) (spec operation)) spec) (defmethod find-operation (context (spec symbol)) (unless (member spec '(nil feature)) @@ -56,13 +55,7 @@ (apply 'make-operation spec (operation-original-initargs context)))) (defmethod operation-original-initargs ((context symbol)) (declare (ignorable context)) - nil) + nil)) - ;; build op was intended to be the master, default operation on a system - ;; (LOAD-OP typically serves that function now). This feature has not yet - ;; been fully implemented yet. - ;; This is a path forward, but is not backwardly compatible, and is not used - ;; yet. [2014/01/26:rpg] - (defclass build-op (operation) ())) diff --git a/output-translations.lisp b/output-translations.lisp index 265876556bc0fb3b3428d92e425a12f781d477b5..205d4d2ed3abf20cd41747b6e15b209c5f380426 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -1,7 +1,7 @@ ;;;; --------------------------------------------------------------------------- ;;;; asdf-output-translations -(asdf/package:define-package :asdf/output-translations +(uiop/package:define-package :asdf/output-translations (:recycle :asdf/output-translations :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade) (:export @@ -222,7 +222,6 @@ and the order is by decreasing length of namestring of the source pathname.") (process-output-translations (parse-output-translations-string string) :inherit inherit :collect collect)) (defmethod process-output-translations ((x null) &key inherit collect) - (declare (ignorable x)) (inherit-output-translations inherit :collect collect)) (defmethod process-output-translations ((form cons) &key inherit collect) (dolist (directive (cdr (validate-output-translations-form form))) diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index f1b792410cc8a0218d75c2eab26fa4cb36839089..129bc55859df22440980626e5d7eb0fafbc6e0ea 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Defsystem -(asdf/package:define-package :asdf/parse-defsystem +(uiop/package:define-package :asdf/parse-defsystem (: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 @@ -143,7 +143,7 @@ do-first if-component-dep-fails version ;; list ends &allow-other-keys) options - (declare (ignorable perform explain output-files operation-done-p builtin-system-p)) + (declare (ignore perform explain output-files operation-done-p builtin-system-p)) (check-component-input type name weakly-depends-on depends-on components) (when (and parent (find-component parent name) diff --git a/plan.lisp b/plan.lisp index 75d4a93164a3b5f65faebbdb2d64507edc330b2b..d564aec5cfc67b4ba7ab939f39fccf090e111b44 100644 --- a/plan.lisp +++ b/plan.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Plan -(asdf/package:define-package :asdf/plan +(uiop/package:define-package :asdf/plan (:recycle :asdf/plan :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/operation :asdf/system @@ -68,9 +68,8 @@ the action of OPERATION on COMPONENT in the PLAN")) (with-slots (stamp done-p planned-p index) status (format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p :planned-p planned-p :index index)))) - (defmethod action-planned-p (action-status) - (declare (ignorable action-status)) ; default method for non planned-action-status objects - t) + (defmethod action-planned-p ((action-status t)) + t) ; default method for non planned-action-status objects ;; TODO: eliminate NODE-FOR, use CONS. ;; Supposes cleaner protocol for operation initargs passed to MAKE-OPERATION. @@ -81,12 +80,10 @@ the action of OPERATION on COMPONENT in the PLAN")) (action-done-p (plan-action-status plan operation component))) (defmethod plan-action-status ((plan null) (o operation) (c component)) - (declare (ignorable plan)) (multiple-value-bind (stamp done-p) (component-operation-time o c) (make-instance 'action-status :stamp stamp :done-p done-p))) (defmethod (setf plan-action-status) (new-status (plan null) (o operation) (c component)) - (declare (ignorable plan)) (let ((to (type-of o)) (times (component-operation-times c))) (if (action-done-p new-status) @@ -107,7 +104,7 @@ the action of OPERATION on COMPONENT in the PLAN")) ((eql t) (when system (list-to-hash-set (list (coerce-name system))))))) (defun action-override-p (plan operation component override-accessor) - (declare (ignorable operation)) + (declare (ignore operation)) (let* ((override (funcall override-accessor plan))) (and override (if (typep override 'hash-table) @@ -131,12 +128,10 @@ the action of OPERATION on COMPONENT in the PLAN")) ;; Force takes precedence over force-not (not (action-forced-p plan operation component)))) - (defmethod action-forced-p ((plan null) operation component) - (declare (ignorable plan operation component)) + (defmethod action-forced-p ((plan null) (operation operation) (component component)) nil) - (defmethod action-forced-not-p ((plan null) operation component) - (declare (ignorable plan operation component)) + (defmethod action-forced-not-p ((plan null) (operation operation) (component component)) nil)) @@ -144,14 +139,11 @@ the action of OPERATION on COMPONENT in the PLAN")) (with-upgradability () (defgeneric action-valid-p (plan operation component) (:documentation "Is this action valid to include amongst dependencies?")) - (defmethod action-valid-p (plan operation (c component)) - (declare (ignorable plan operation)) + (defmethod action-valid-p ((plan plan-traversal) (o operation) (c component)) (if-let (it (component-if-feature c)) (featurep it) t)) - (defmethod action-valid-p (plan (o null) c) (declare (ignorable plan o c)) nil) - (defmethod action-valid-p (plan o (c null)) (declare (ignorable plan o c)) nil) - (defmethod action-valid-p ((plan null) operation component) - (declare (ignorable plan operation component)) - (and operation component t))) + (defmethod action-valid-p ((plan t) (o null) (c t)) nil) + (defmethod action-valid-p ((plan t) (o t) (c null)) nil) + (defmethod action-valid-p ((plan null) (o operation) (c component)) t)) ;;;; Is the action needed in this image? @@ -189,6 +181,12 @@ the action of OPERATION on COMPONENT in the PLAN")) (defun direct-dependencies (operation component) (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, + ;; so they need not refer to the state of the filesystem, + ;; and the stamps could be cryptographic checksums rather than timestamps. + ;; Such a change remarkably would only affect VISIT-DEPENDENCIES and COMPUTE-ACTION-STAMP. + (defun visit-dependencies (plan operation component dependency-stamper &aux stamp) (map-direct-dependencies operation component @@ -198,8 +196,16 @@ the action of OPERATION on COMPONENT in the PLAN")) stamp) (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done) - ;; In a distant future, get-file-stamp and component-operation-time - ;; shall also be parametrized by the plan, or by a second model object. + ;; Given an action, figure out at what time in the past it has been done, + ;; 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. + ;; 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, + ;; yet a NIL done-in-image-p flag. (let* ((stamp-lookup #'(lambda (o c) (if-let (it (plan-action-status plan o c)) (action-stamp it) t))) (out-files (output-files o c)) @@ -300,6 +306,20 @@ the action of OPERATION on COMPONENT in the PLAN")) (defgeneric traverse-action (plan operation component needed-in-image-p)) + ;; 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. + ;; + ;; 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) (block nil ;; ACTION-VALID-P among other things, handles forcing logic, including @@ -315,34 +335,33 @@ the action of OPERATION on COMPONENT in the PLAN")) (eniip (and aniip needed-in-image-p)) (status (plan-action-status plan operation component))) (when (and status (or (action-done-p status) (action-planned-p status) (not eniip))) - ;; Already visited with sufficient need-in-image level: just return the stamp. - (return (action-stamp status))) - (labels ((visit-action (niip) - (visit-dependencies plan operation component + (return (action-stamp status))) ; Already visited with sufficient need-in-image level! + (labels ((visit-action (niip) ; We may visit the action twice, once with niip NIL, then T + (visit-dependencies plan operation component ; recursively traverse dependencies #'(lambda (o c) (traverse-action plan o c niip))) - (multiple-value-bind (stamp done-p) - (compute-action-stamp plan operation component) + (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))))) - (cond - ((and add-to-plan-p (not niip)) ;; if we need to do it, - (visit-action t)) ;; then we need to do it in the image! + (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, + (visit-action t)) ; then we need to do it *in the (current) image*! (t - (setf (plan-action-status plan operation component) + (setf (plan-action-status plan operation component) ; update status: (make-instance 'planned-action-status - :stamp stamp - :done-p (and done-p (not add-to-plan-p)) - :planned-p add-to-plan-p - :index (if status - (action-index status) - (incf (plan-total-action-count plan))))) - (when add-to-plan-p - (incf (plan-planned-action-count plan)) - (unless aniip - (incf (plan-planned-output-action-count plan)))) - stamp)))))) + :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 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-action eniip))))))) ; visit the action ;;;; Sequential plans (the default) @@ -356,9 +375,7 @@ the action of OPERATION on COMPONENT in the PLAN")) (defmethod plan-actions ((plan sequential-plan)) (reverse (plan-actions-r plan))) - (defmethod plan-record-dependency ((plan sequential-plan) - (operation operation) (component component)) - (declare (ignorable plan operation component)) + (defmethod plan-record-dependency ((plan sequential-plan) (o operation) (c component)) (values)) (defmethod (setf plan-action-status) :after diff --git a/source-registry.lisp b/source-registry.lisp index cd7ab5ae19a61296a9e0750ef34cae0bc3b59857..70bac4b96807acd04019dccdbb68666788cc73f3 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -2,7 +2,7 @@ ;;;; Source Registry Configuration, by Francois-Rene Rideau ;;;; See the Manual and https://bugs.launchpad.net/asdf/+bug/485918 -(asdf/package:define-package :asdf/source-registry +(uiop/package:define-package :asdf/source-registry (:recycle :asdf/source-registry :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system) (:export @@ -235,7 +235,6 @@ system names to pathnames of .asd files") (process-source-registry (parse-source-registry-string string) :inherit inherit :register register)) (defmethod process-source-registry ((x null) &key inherit register) - (declare (ignorable x)) (inherit-source-registry inherit :register register)) (defmethod process-source-registry ((form cons) &key inherit register) (let ((*source-registry-exclusions* *default-source-registry-exclusions*)) diff --git a/system.lisp b/system.lisp index 40a8324f93aa280c6280a17ca1c59524510fad4b..02eab6bbbe45f28e67fe10d292cfe710c344f17c 100644 --- a/system.lisp +++ b/system.lisp @@ -1,7 +1,7 @@ ;;;; ------------------------------------------------------------------------- ;;;; Systems -(asdf/package:define-package :asdf/system +(uiop/package:define-package :asdf/system (:recycle :asdf :asdf/system) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component) (:export @@ -29,7 +29,6 @@ (defgeneric component-entry-point (component)) (defmethod component-entry-point ((c component)) - (declare (ignorable c)) nil)) @@ -106,6 +105,5 @@ in which the system specification (.asd file) is located." (system-source-directory system)) (defmethod component-build-pathname ((c component)) - (declare (ignorable c)) nil)) diff --git a/test/run-tests.sh b/test/run-tests.sh index 22e632e47c096ac5225731bbbd502f067b46f284..db96c629235ab744316211400185d9c1c44e488e 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -393,8 +393,6 @@ valid_upgrade_test_p () { # It's damn slow. Also, for some reason, we punt on anything earlier than 2.25, # and only need to test it once, below for 2.24. abcl:1.*|abcl:2.00[0-9]:*|abcl:201[0-9]:*|abcl:2.2[0-3]:*) : ;; - # Skip allegro modern on 1.x -- fails for rpgoldman on his mac (!) - allegromodern:1.*) : ;; # ccl fasl numbering broke loading of old asdf 2.0 ccl:2.0[01]*) : ;; # My old ubuntu 10.04LTS clisp 2.44.1 came wired in diff --git a/test/test-operation-classes.script b/test/test-operation-classes.script index 152b7727e254cba04f3bdd386e562766d012007b..fac4006ab04db7cf9be83f3c1bb8e5acbab33b9f 100644 --- a/test/test-operation-classes.script +++ b/test/test-operation-classes.script @@ -39,34 +39,21 @@ "All of these classes should be instantiable without error.") (defclass my-unupdated-operation (operation) - () - ) + ()) (defclass my-good-operation (downward-operation) - () - ) + ()) (defclass my-incoherent-operation (downward-operation non-propagating-operation) - () - ) + ()) -(loop :for class :in *good-classes* - :do (assert (make-instance class))) +(dolist (class *good-classes*) (assert (make-instance class))) -(assert - (catch 'op-def-error - (handler-bind ((operation-definition-error #'(lambda (e) - (declare (ignore e)) - (throw 'op-def-error t)))) - (make-instance 'my-unupdated-operation) - nil))) +(signals operation-definition-warning + (make-instance 'my-unupdated-operation)) -(assert - (catch 'op-def-error - (handler-bind ((operation-definition-error #'(lambda (e) - (declare (ignore e)) - (throw 'op-def-error t)))) - (make-instance 'my-incoherent-operation) - nil))) +#-gcl +(signals operation-definition-error + (make-instance 'my-incoherent-operation)) (assert (make-instance 'my-good-operation)) diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index 3ec8a8fd8899f63ef763cf4aaeaa3fdeb2095660..7a19e53f0dc2f2917a6b5258bf6fcd1449a36050 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -185,35 +185,27 @@ Programmers are encouraged to define their own methods for this generic function :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size)) (defmethod slurp-input-stream ((x (eql 'string)) stream &key stripped) - (declare (ignorable x)) (slurp-stream-string stream :stripped stripped)) (defmethod slurp-input-stream ((x (eql :string)) stream &key stripped) - (declare (ignorable x)) (slurp-stream-string stream :stripped stripped)) (defmethod slurp-input-stream ((x (eql :lines)) stream &key count) - (declare (ignorable x)) (slurp-stream-lines stream :count count)) (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0)) - (declare (ignorable x)) (slurp-stream-line stream :at at)) (defmethod slurp-input-stream ((x (eql :forms)) stream &key count) - (declare (ignorable x)) (slurp-stream-forms stream :count count)) (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0)) - (declare (ignorable x)) (slurp-stream-form stream :at at)) (defmethod slurp-input-stream ((x (eql t)) stream &rest keys &key &allow-other-keys) - (declare (ignorable x)) (apply 'slurp-input-stream *standard-output* stream keys)) - (defmethod slurp-input-stream ((x null) stream &key) - (declare (ignorable x stream)) + (defmethod slurp-input-stream ((x null) (stream t) &key) nil) (defmethod slurp-input-stream ((pathname pathname) input @@ -288,11 +280,9 @@ Programmers are encouraged to define their own methods for this generic function (values)) (defmethod vomit-output-stream ((x (eql t)) stream &rest keys &key &allow-other-keys) - (declare (ignorable x)) (apply 'vomit-output-stream *standard-input* stream keys)) - (defmethod vomit-output-stream ((x null) stream &key) - (declare (ignorable x stream)) + (defmethod vomit-output-stream ((x null) (stream t) &key) (values)) (defmethod vomit-output-stream ((pathname pathname) input diff --git a/upgrade.lisp b/upgrade.lisp index fa0586de3ab1b3676c02cac45820ba1e4118f4cb..6482395183c7b189fc4d5db2c27e6079bb469651 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -2,7 +2,7 @@ ;;;; Handle upgrade as forward- and backward-compatibly as possible ;; See https://bugs.launchpad.net/asdf/+bug/485687 -(asdf/package:define-package :asdf/upgrade +(uiop/package:define-package :asdf/upgrade (:recycle :asdf/upgrade :asdf) (:use :uiop/common-lisp :uiop) (:export @@ -12,7 +12,7 @@ #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf ;; There will be no symbol left behind! #:intern*) - (:import-from :asdf/package #:intern* #:find-symbol*)) + (:import-from :uiop/package #:intern* #:find-symbol*)) (in-package :asdf/upgrade) ;;; Special magic to detect if this is an upgrade @@ -66,7 +66,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.1.0.54") + (asdf-version "3.1.0.60") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -100,8 +100,7 @@ previously-loaded version of ASDF." #:component-self-dependencies #:resolve-relative-location-component #:resolve-absolute-location-component #:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function - (declare (ignorable redefined-functions uninterned-symbols)) - (loop :for name :in (append redefined-functions) + (loop :for name :in redefined-functions :for sym = (find-symbol* name :asdf nil) :do (when sym ;; On CLISP we seem to be unable to fmakunbound and define a function in the same fasl. Sigh. diff --git a/user.lisp b/user.lisp index a49f76bff775b43b0797b65e9a538e69d91c43bb..0cf64247747d9e557c1df8f52c1b8be250bd5c4d 100644 --- a/user.lisp +++ b/user.lisp @@ -1,6 +1,8 @@ ;;;; --------------------------------------------------------------------------- ;;;; ASDF-USER, where the action happens. -(asdf/package:define-package :asdf/user +(uiop/package:define-package :asdf/user (:nicknames :asdf-user) - (:use :asdf/common-lisp :asdf/package :asdf/interface)) + ;; TODO: it would be nice to have :UIOP in the list, + ;; but we need test compatibility with cl-test-grid first. + (:use :uiop/common-lisp :uiop/package :asdf/interface)) diff --git a/version.lisp-expr b/version.lisp-expr index ff2172f49daf5cec80a899b564aa4c9b5ee5cb2f..8747d8de597df9686345f75fd2111fae2a7cfd9c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,2 @@ -"3.1.0.54" +"3.1.0.60"