Commit c7d1ce63 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

More cleanups:

* Add some comments on TRAVERSE-ACTION; expand those on SOURCE-FILE-TYPE.
* Remove a few unnecessary input-files or output-files methods
* Remove (declare (ignorable ...)) for specialized arguments. Specialize a few arguments to T.
* Remove most when-upgrading methods, since we drop data on old incompatible ASDFs.
parent d722ad15
...@@ -267,7 +267,6 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m ...@@ -267,7 +267,6 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m
(define-convenience-action-methods operation-done-p (operation component)) (define-convenience-action-methods operation-done-p (operation component))
(defmethod operation-done-p ((o operation) (c component)) (defmethod operation-done-p ((o operation) (c component))
(declare (ignorable o c))
t) t)
(defmethod output-files :around (operation component) (defmethod output-files :around (operation component)
...@@ -289,7 +288,6 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m ...@@ -289,7 +288,6 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m
(mapcar *output-translation-function* absolute-pathnames)))) (mapcar *output-translation-function* absolute-pathnames))))
t))) t)))
(defmethod output-files ((o operation) (c component)) (defmethod output-files ((o operation) (c component))
(declare (ignorable o c))
nil) nil)
(defun output-file (operation component) (defun output-file (operation component)
"The unique output file of performing OPERATION on COMPONENT" "The unique output file of performing OPERATION on COMPONENT"
...@@ -303,7 +301,6 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m ...@@ -303,7 +301,6 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m
(call-next-method))) (call-next-method)))
(defmethod input-files ((o operation) (c component)) (defmethod input-files ((o operation) (c component))
(declare (ignorable o c))
nil) nil)
(defmethod input-files ((o selfward-operation) (c component)) (defmethod input-files ((o selfward-operation) (c component))
...@@ -369,7 +366,6 @@ in some previous image, or T if it needs to be done.") ...@@ -369,7 +366,6 @@ in some previous image, or T if it needs to be done.")
(defmethod perform :after ((o operation) (c component)) (defmethod perform :after ((o operation) (c component))
(mark-operation-done o c)) (mark-operation-done o c))
(defmethod perform ((o operation) (c parent-component)) (defmethod perform ((o operation) (c parent-component))
(declare (ignorable o c))
nil) nil)
(defmethod perform ((o operation) (c source-file)) (defmethod perform ((o operation) (c source-file))
(sysdef-error (sysdef-error
......
...@@ -43,13 +43,13 @@ ...@@ -43,13 +43,13 @@
(defgeneric (setf operation-on-warnings) (x operation)) (defgeneric (setf operation-on-warnings) (x operation))
(defgeneric (setf operation-on-failure) (x operation)) (defgeneric (setf operation-on-failure) (x operation))
(defmethod operation-on-warnings ((o operation)) (defmethod operation-on-warnings ((o operation))
(declare (ignorable o)) *compile-file-warnings-behaviour*) *compile-file-warnings-behaviour*)
(defmethod operation-on-failure ((o operation)) (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)) (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)) (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) (defun system-definition-pathname (x)
;; As of 2.014.8, we mean to make this function obsolete, ;; As of 2.014.8, we mean to make this function obsolete,
...@@ -119,7 +119,7 @@ processed in order by OPERATE.")) ...@@ -119,7 +119,7 @@ processed in order by OPERATE."))
:ignore-inherited-configuration)))) :ignore-inherited-configuration))))
(defmethod operate :before (operation-class system &rest args &key &allow-other-keys) (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) (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. (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, ASDF 2 now achieves the same purpose with its builtin ASDF-OUTPUT-TRANSLATIONS,
......
...@@ -157,7 +157,7 @@ ...@@ -157,7 +157,7 @@
(defmethod initialize-instance :after ((instance bundle-op) &rest initargs (defmethod initialize-instance :after ((instance bundle-op) &rest initargs
&key (name-suffix nil name-suffix-p) &key (name-suffix nil name-suffix-p)
&allow-other-keys) &allow-other-keys)
(declare (ignorable initargs name-suffix)) (declare (ignore initargs name-suffix))
(unless name-suffix-p (unless name-suffix-p
(setf (slot-value instance 'name-suffix) (setf (slot-value instance 'name-suffix)
(unless (typep instance 'program-op) (unless (typep instance 'program-op)
...@@ -178,7 +178,6 @@ ...@@ -178,7 +178,6 @@
(operation-original-initargs instance)))) (operation-original-initargs instance))))
(defmethod bundle-op-build-args :around ((o no-ld-flags-op)) (defmethod bundle-op-build-args :around ((o no-ld-flags-op))
(declare (ignorable o))
(let ((args (call-next-method))) (let ((args (call-next-method)))
(remf args :ld-flags) (remf args :ld-flags)
args)) args))
...@@ -223,7 +222,6 @@ ...@@ -223,7 +222,6 @@
,@(call-next-method))) ,@(call-next-method)))
(defmethod component-depends-on :around ((o bundle-op) (c component)) (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))) (if-let (op (and (eq (type-of o) 'bundle-op) (component-build-operation c)))
`((,op ,c)) `((,op ,c))
(call-next-method))) (call-next-method)))
...@@ -285,7 +283,6 @@ ...@@ -285,7 +283,6 @@
;;; ;;;
(with-upgradability () (with-upgradability ()
(defmethod component-depends-on ((o load-fasl-op) (c system)) (defmethod component-depends-on ((o load-fasl-op) (c system))
(declare (ignorable o))
`((,o ,@(loop :for dep :in (component-sideway-dependencies c) `((,o ,@(loop :for dep :in (component-sideway-dependencies c)
:collect (resolve-dependency-spec c dep))) :collect (resolve-dependency-spec c dep)))
(,(if (user-system-p c) 'fasl-op 'load-op) ,c) (,(if (user-system-p c) 'fasl-op 'load-op) ,c)
...@@ -295,10 +292,6 @@ ...@@ -295,10 +292,6 @@
(when (user-system-p c) (when (user-system-p c)
(output-files (find-operation o 'fasl-op) 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)) (defmethod perform ((o load-fasl-op) (c system))
(when (input-files o c) (when (input-files o c)
(perform-lisp-load-fasl o c))) (perform-lisp-load-fasl o c)))
...@@ -316,11 +309,7 @@ ...@@ -316,11 +309,7 @@
(defmethod trivial-system-p ((s system)) (defmethod trivial-system-p ((s system))
(every #'(lambda (c) (typep c 'compiled-file)) (component-children s))) (every #'(lambda (c) (typep c 'compiled-file)) (component-children s)))
(defmethod output-files (o (c compiled-file)) (defmethod input-files ((o operation) (c compiled-file))
(declare (ignorable o c))
nil)
(defmethod input-files (o (c compiled-file))
(declare (ignorable o))
(component-pathname c)) (component-pathname c))
(defmethod perform ((o load-op) (c compiled-file)) (defmethod perform ((o load-op) (c compiled-file))
(perform-lisp-load-fasl o c)) (perform-lisp-load-fasl o c))
...@@ -329,7 +318,6 @@ ...@@ -329,7 +318,6 @@
(defmethod perform ((o load-fasl-op) (c compiled-file)) (defmethod perform ((o load-fasl-op) (c compiled-file))
(perform (find-operation o 'load-op) c)) (perform (find-operation o 'load-op) c))
(defmethod perform ((o operation) (c compiled-file)) (defmethod perform ((o operation) (c compiled-file))
(declare (ignorable o c))
nil)) nil))
;;; ;;;
...@@ -337,19 +325,15 @@ ...@@ -337,19 +325,15 @@
;;; ;;;
(with-upgradability () (with-upgradability ()
(defmethod trivial-system-p ((s prebuilt-system)) (defmethod trivial-system-p ((s prebuilt-system))
(declare (ignorable s))
t) t)
(defmethod perform ((o lib-op) (c prebuilt-system)) (defmethod perform ((o lib-op) (c prebuilt-system))
(declare (ignorable o c))
nil) nil)
(defmethod component-depends-on ((o lib-op) (c prebuilt-system)) (defmethod component-depends-on ((o lib-op) (c prebuilt-system))
(declare (ignorable o c))
nil) nil)
(defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system)) (defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system))
(declare (ignorable o))
nil)) nil))
...@@ -422,14 +406,12 @@ ...@@ -422,14 +406,12 @@
(combine-fasls fasl-files output-file))))) (combine-fasls fasl-files output-file)))))
(defmethod input-files ((o load-op) (s precompiled-system)) (defmethod input-files ((o load-op) (s precompiled-system))
(declare (ignorable o))
(bundle-output-files (find-operation o 'fasl-op) s)) (bundle-output-files (find-operation o 'fasl-op) s))
(defmethod perform ((o load-op) (s precompiled-system)) (defmethod perform ((o load-op) (s precompiled-system))
(perform-lisp-load-fasl o s)) (perform-lisp-load-fasl o s))
(defmethod component-depends-on ((o load-fasl-op) (s precompiled-system)) (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system))
(declare (ignorable o))
`((load-op ,s) ,@(call-next-method)))) `((load-op ,s) ,@(call-next-method))))
#| ;; Example use: #| ;; Example use:
...@@ -496,8 +478,9 @@ ...@@ -496,8 +478,9 @@
#+(and (not asdf-use-unsafe-mac-bundle-op) #+(and (not asdf-use-unsafe-mac-bundle-op)
(or (and ecl darwin) (and abcl darwin))) (or (and ecl darwin) (and abcl darwin)))
(defmethod perform :before ((op basic-fasl-op) c) (defmethod perform :before ((o basic-fasl-op) (c component))
(declare (ignorable op c)) (unless (featurep :asdf-use-unsafe-mac-bundle-op)
(unless (uiop:featurep :asdf-use-unsafe-mac-bundle-op)
(cerror "Continue after modifying *FEATURES*." (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.")))
...@@ -61,7 +61,7 @@ another pathname in a degenerate way.")) ...@@ -61,7 +61,7 @@ another pathname in a degenerate way."))
(defgeneric component-version (component)) (defgeneric component-version (component))
(defgeneric (setf component-version) (new-version component)) (defgeneric (setf component-version) (new-version component))
(defgeneric component-parent (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. ;; Backward compatible way of computing the FILE-TYPE of a component.
;; TODO: find users, have them stop using that, remove it for ASDF4. ;; TODO: find users, have them stop using that, remove it for ASDF4.
...@@ -83,11 +83,6 @@ another pathname in a degenerate way.")) ...@@ -83,11 +83,6 @@ another pathname in a degenerate way."))
(duplicate-names-name c)))))) (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 () (with-upgradability ()
(defclass component () (defclass component ()
((name :accessor component-name :initarg :name :type string :documentation ((name :accessor component-name :initarg :name :type string :documentation
...@@ -203,19 +198,6 @@ another pathname in a degenerate way.")) ...@@ -203,19 +198,6 @@ another pathname in a degenerate way."))
(setf (gethash name hash) c)) (setf (gethash name hash) c))
hash)))) 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 () (with-upgradability ()
(defclass module (child-component parent-component) (defclass module (child-component parent-component)
(#+clisp (components)))) ;; backward compatibility during upgrade only (#+clisp (components)))) ;; backward compatibility during upgrade only
...@@ -241,9 +223,10 @@ another pathname in a degenerate way.")) ...@@ -241,9 +223,10 @@ another pathname in a degenerate way."))
pathname))) pathname)))
(defmethod component-relative-pathname ((component component)) (defmethod component-relative-pathname ((component component))
;; source-file-type is backward-compatibility with ASDF1; ;; 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. ;; 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. ;; 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 (parse-unix-namestring
(or (and (slot-boundp component 'relative-pathname) (or (and (slot-boundp component 'relative-pathname)
(slot-value component 'relative-pathname)) (slot-value component 'relative-pathname))
...@@ -252,12 +235,10 @@ another pathname in a degenerate way.")) ...@@ -252,12 +235,10 @@ another pathname in a degenerate way."))
:type (source-file-type component (component-system component)) :type (source-file-type component (component-system component))
:defaults (component-parent-pathname component))) :defaults (component-parent-pathname component)))
(defmethod source-file-type ((component parent-component) system) (defmethod source-file-type ((component parent-component) (system parent-component))
(declare (ignorable component system))
:directory) :directory)
(defmethod source-file-type ((component file-component) system) (defmethod source-file-type ((component file-component) (system parent-component))
(declare (ignorable system))
(file-type component))) (file-type component)))
......
...@@ -79,8 +79,7 @@ ...@@ -79,8 +79,7 @@
(defmethod find-component ((c component) (name cons)) (defmethod find-component ((c component) (name cons))
(find-component (find-component c (car name)) (cdr name))) (find-component (find-component c (car name)) (cdr name)))
(defmethod find-component (base (actual component)) (defmethod find-component ((base t) (actual component))
(declare (ignorable base))
actual) actual)
(defun resolve-dependency-name (component name &optional version) (defun resolve-dependency-name (component name &optional version)
...@@ -120,11 +119,9 @@ ...@@ -120,11 +119,9 @@
(cons combinator arguments) component)) (cons combinator arguments) component))
(defmethod resolve-dependency-combination (component (combinator (eql :feature)) arguments) (defmethod resolve-dependency-combination (component (combinator (eql :feature)) arguments)
(declare (ignorable combinator))
(when (featurep (first arguments)) (when (featurep (first arguments))
(resolve-dependency-spec component (second arguments)))) (resolve-dependency-spec component (second arguments))))
(defmethod resolve-dependency-combination (component (combinator (eql :version)) 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)))) ;; See lp#527788
(resolve-dependency-name component (first arguments) (second arguments))))
...@@ -246,7 +246,6 @@ Going forward, we recommend new users should be using the source-registry. ...@@ -246,7 +246,6 @@ Going forward, we recommend new users should be using the source-registry.
(register-preloaded-system s :version *asdf-version*)) (register-preloaded-system s :version *asdf-version*))
(defmethod find-system ((name null) &optional (error-p t)) (defmethod find-system ((name null) &optional (error-p t))
(declare (ignorable name))
(when error-p (when error-p
(sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>")))) (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>"))))
......
...@@ -60,22 +60,17 @@ ...@@ -60,22 +60,17 @@
;;; prepare-op ;;; prepare-op
(with-upgradability () (with-upgradability ()
(defmethod action-description ((o prepare-op) (c component)) (defmethod action-description ((o prepare-op) (c component))
(declare (ignorable o))
(format nil (compatfmt "~@<loading dependencies of ~3i~_~A~@:>") c)) (format nil (compatfmt "~@<loading dependencies of ~3i~_~A~@:>") c))
(defmethod perform ((o prepare-op) (c component)) (defmethod perform ((o prepare-op) (c component))
(declare (ignorable o c))
nil) nil)
(defmethod input-files ((o prepare-op) (s system)) (defmethod input-files ((o prepare-op) (s system))
(declare (ignorable o))
(if-let (it (system-source-file s)) (list it)))) (if-let (it (system-source-file s)) (list it))))
;;; compile-op ;;; compile-op
(with-upgradability () (with-upgradability ()
(defmethod action-description ((o compile-op) (c component)) (defmethod action-description ((o compile-op) (c component))
(declare (ignorable o))
(format nil (compatfmt "~@<compiling ~3i~_~A~@:>") c)) (format nil (compatfmt "~@<compiling ~3i~_~A~@:>") c))
(defmethod action-description ((o compile-op) (c parent-component)) (defmethod action-description ((o compile-op) (c parent-component))
(declare (ignorable o))
(format nil (compatfmt "~@<completing compilation for ~3i~_~A~@:>") c)) (format nil (compatfmt "~@<completing compilation for ~3i~_~A~@:>") c))
(defgeneric call-with-around-compile-hook (component thunk)) (defgeneric call-with-around-compile-hook (component thunk))
(defmethod call-with-around-compile-hook ((c component) function) (defmethod call-with-around-compile-hook ((c component) function)
...@@ -141,10 +136,6 @@ ...@@ -141,10 +136,6 @@
(defmethod output-files ((o compile-op) (c cl-source-file)) (defmethod output-files ((o compile-op) (c cl-source-file))
(lisp-compilation-output-files o c)) (lisp-compilation-output-files o c))
(defmethod perform ((o compile-op) (c static-file)) (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) nil)
(defmethod perform ((o compile-op) (c system)) (defmethod perform ((o compile-op) (c system))
(when (and *warnings-file-type* (not (builtin-system-p c))) (when (and *warnings-file-type* (not (builtin-system-p c)))
...@@ -164,15 +155,11 @@ ...@@ -164,15 +155,11 @@
;;; load-op ;;; load-op
(with-upgradability () (with-upgradability ()
(defmethod action-description ((o load-op) (c cl-source-file)) (defmethod action-description ((o load-op) (c cl-source-file))
(declare (ignorable o))
(format nil (compatfmt "~@<loading FASL for ~3i~_~A~@:>") c)) (format nil (compatfmt "~@<loading FASL for ~3i~_~A~@:>") c))
(defmethod action-description ((o load-op) (c parent-component)) (defmethod action-description ((o load-op) (c parent-component))
(declare (ignorable o))
(format nil (compatfmt "~@<completing load for ~3i~_~A~@:>") c)) (format nil (compatfmt "~@<completing load for ~3i~_~A~@:>") c))
(defmethod action-description ((o load-op) component) (defmethod action-description ((o load-op) (c component))
(declare (ignorable o)) (format nil (compatfmt "~@<loading ~3i~_~A~@:>") c))
(format nil (compatfmt "~@<loading ~3i~_~A~@:>")
component))
(defmethod perform-with-restarts ((o load-op) (c cl-source-file)) (defmethod perform-with-restarts ((o load-op) (c cl-source-file))
(loop (loop
(restart-case (restart-case
...@@ -188,7 +175,6 @@ ...@@ -188,7 +175,6 @@
(defmethod perform ((o load-op) (c cl-source-file)) (defmethod perform ((o load-op) (c cl-source-file))
(perform-lisp-load-fasl o c)) (perform-lisp-load-fasl o c))
(defmethod perform ((o load-op) (c static-file)) (defmethod perform ((o load-op) (c static-file))
(declare (ignorable o c))
nil)) nil))
...@@ -197,25 +183,17 @@ ...@@ -197,25 +183,17 @@
;;; prepare-source-op ;;; prepare-source-op
(with-upgradability () (with-upgradability ()
(defmethod action-description ((o prepare-source-op) (c component)) (defmethod action-description ((o prepare-source-op) (c component))
(declare (ignorable o))
(format nil (compatfmt "~@<loading source for dependencies of ~3i~_~A~@:>") c)) (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)) (defmethod input-files ((o prepare-source-op) (s system))
(declare (ignorable o))
(if-let (it (system-source-file s)) (list it))) (if-let (it (system-source-file s)) (list it)))
(defmethod perform ((o prepare-source-op) (c component)) (defmethod perform ((o prepare-source-op) (c component))
(declare (ignorable o c))
nil)) nil))
;;; load-source-op ;;; load-source-op
(with-upgradability () (with-upgradability ()
(defmethod action-description ((o load-source-op) c) (defmethod action-description ((o load-source-op) (c component))
(declare (ignorable o))
(format nil (compatfmt "~@<Loading source of ~3i~_~A~@:>") c)) (format nil (compatfmt "~@<Loading source of ~3i~_~A~@:>") c))
(defmethod action-description ((o load-source-op) (c parent-component)) (defmethod action-description ((o load-source-op) (c parent-component))
(declare (ignorable o))
(format nil (compatfmt "~@<Loaded source of ~3i~_~A~@:>") c)) (format nil (compatfmt "~@<Loaded source of ~3i~_~A~@:>") c))
(defun perform-lisp-load-source (o c) (defun perform-lisp-load-source (o c)
(call-with-around-compile-hook (call-with-around-compile-hook
...@@ -226,20 +204,14 @@ ...@@ -226,20 +204,14 @@
(defmethod perform ((o load-source-op) (c cl-source-file)) (defmethod perform ((o load-source-op) (c cl-source-file))
(perform-lisp-load-source o c)) (perform-lisp-load-source o c))
(defmethod perform ((o load-source-op) (c static-file)) (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)) nil))
;;;; test-op ;;;; test-op
(with-upgradability () (with-upgradability ()
(defmethod perform ((o test-op) (c component)) (defmethod perform ((o test-op) (c component))
(declare (ignorable o c))
nil) nil)
(defmethod operation-done-p ((o test-op) (c system)) (defmethod operation-done-p ((o test-op) (c system))
"Testing a system is _never_ done." "Testing a system is _never_ done."
(declare (ignorable o c))
nil)) nil))
...@@ -53,7 +53,6 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: ...@@ -53,7 +53,6 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
&key verbose &key verbose
(on-warnings *compile-file-warnings-behaviour*) (on-warnings *compile-file-warnings-behaviour*)
(on-failure *compile-file-failure-behaviour*) &allow-other-keys) (on-failure *compile-file-failure-behaviour*) &allow-other-keys)
(declare (ignorable operation component))
(let* ((systems-being-operated *systems-being-operated*) (let* ((systems-being-operated *systems-being-operated*)
(*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal))) (*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal)))
(operation-name (reify-symbol (etypecase operation (operation-name (reify-symbol (etypecase operation
...@@ -160,18 +159,15 @@ for how to load or compile stuff") ...@@ -160,18 +159,15 @@ for how to load or compile stuff")
((module :initarg :module :initform nil :accessor required-module))) ((module :initarg :module :initform nil :accessor required-module)))
(defmethod perform ((o compile-op) (c require-system)) (defmethod perform ((o compile-op) (c require-system))
(declare (ignorable o c))
nil) nil)
(defmethod perform ((o load-op) (s require-system)) (defmethod perform ((o load-op) (s require-system))
(declare (ignorable o))
(let* ((module (or (required-module s) (coerce-name s))) (let* ((module (or (required-module s) (coerce-name s)))
(*modules-being-required* (cons module *modules-being-required*))) (*modules-being-required* (cons module *modules-being-required*)))
(assert (null (component-children s))) (assert (null (component-children s)))
(require module))) (require module)))
(defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments) (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments)
(declare (ignorable component combinator))
(unless (length=n-p arguments 1) (unless (length=n-p arguments 1)
(error (compatfmt "~@<Bad dependency ~S for ~S. ~S takes only one argument~@:>") (error (compatfmt "~@<Bad dependency ~S for ~S. ~S takes only one argument~@:>")
(cons combinator arguments) component combinator)) (cons combinator arguments) component combinator))
......
...@@ -14,8 +14,9 @@ ...@@ -14,8 +14,9 @@
;;; Operation Classes ;;; Operation Classes
(when-upgrading (:when (find-class 'operation nil)) (when-upgrading (:when (find-class 'operation nil))
(defmethod shared-initialize :after ((o operation) slot-names &rest initargs &key) ;; override any obsolete shared-initialize method when upgrading from ASDF2.
(declare (ignorable o slot-names initargs)) (values))) (defmethod shared-initialize :after ((o operation) (slot-names t) &key)
(values)))
(with-upgradability () (with-upgradability ()
(defclass operation () (defclass operation ()
...@@ -26,7 +27,7 @@ ...@@ -26,7 +27,7 @@
;; already bound. ;; already bound.
(defmethod initialize-instance :after ((o operation) &rest initargs (defmethod initialize-instance :after ((o operation) &rest initargs
&key force force-not system verbose &allow-other-keys) &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)