From c0a814bdf0cdfea8072ccac68405302ca6d5941d Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sun, 17 Mar 2013 10:10:32 -0400 Subject: [PATCH] 2.32.13: fix dependency issues for monolithic-fasl-op Rename sibling-operation sideway-operation, sibling-dependencies sideway-dependencies. No one in quicklisp was using the old name. Introduce selfward-operation for the common pattern. Have a prepare-fasl-op to gracefully propagate fasl-op. Reset component-depends-on when upgrading. Refactor concatenate-source-op in a likewise fashion. --- action.lisp | 60 +++++++------- asdf.asd | 2 +- backward-interface.lisp | 2 +- bundle.lisp | 119 ++++++++++++++-------------- component.lisp | 6 +- concatenate-source.lisp | 72 +++++++---------- defsystem.lisp | 2 +- header.lisp | 2 +- interface.lisp | 11 ++- lisp-action.lisp | 52 +++++------- plan.lisp | 3 +- test/test-concatenate-source.script | 6 +- test/test-utilities.script | 2 +- test/test-xach-update-bug.script | 64 ++++++++++----- uiop/utility.lisp | 9 ++- upgrade.lisp | 5 +- version.lisp-expr | 2 +- 17 files changed, 213 insertions(+), 206 deletions(-) diff --git a/action.lisp b/action.lisp index 8edf15e1..6f464665 100644 --- a/action.lisp +++ b/action.lisp @@ -9,8 +9,8 @@ (:export #:action #:define-convenience-action-methods #:explain #:action-description - #:downward-operation #:upward-operation #:sibling-operation - #:component-depends-on #:component-self-dependencies + #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation + #:component-depends-on #:input-files #:output-files #:output-file #:operation-done-p #:action-status #:action-stamp #:action-done-p #:component-operation-time #:mark-operation-done #:compute-action-stamp @@ -88,7 +88,7 @@ You can put together sentences using this phrase.")) ;;;; Dependencies (with-upgradability () - (defgeneric component-depends-on (operation component) ;; ASDF4: rename to component-dependencies + (defgeneric* (component-depends-on) (operation component) ;; ASDF4: rename to component-dependencies (:documentation "Returns a list of dependencies needed by the component to perform the operation. A dependency has one of the following forms: @@ -106,19 +106,15 @@ You can put together sentences using this phrase.")) Methods specialized on subclasses of existing component types should usually append the results of CALL-NEXT-METHOD to the list.")) - (defgeneric component-self-dependencies (operation component)) (define-convenience-action-methods component-depends-on (operation component)) - (define-convenience-action-methods component-self-dependencies (operation component)) + + (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 + (cdr (assoc (type-of o) (component-in-order-to c))))) ; User-specified in-order dependencies - (defmethod component-self-dependencies ((o operation) (c component)) - ;; NB: result in the same format as component-depends-on - (loop* :for (o-spec . c-spec) :in (component-depends-on o c) - :unless (eq o-spec 'feature) ;; avoid the FEATURE "feature" - :when (find c c-spec :key #'(lambda (dep) (resolve-dependency-spec c dep))) - :collect (list o-spec c)))) ;;;; upward-operation, downward-operation ;; These together handle actions that propagate along the component hierarchy. @@ -128,7 +124,7 @@ You can put together sentences using this phrase.")) (with-upgradability () (defclass downward-operation (operation) ((downward-operation - :initform nil :initarg :downward-operation :reader downward-operation))) + :initform nil :initarg :downward-operation :reader downward-operation :allocation :class))) (defmethod component-depends-on ((o downward-operation) (c parent-component)) `((,(or (downward-operation o) o) ,@(component-children c)) ,@(call-next-method))) ;; Upward operations like prepare-op propagate up the component hierarchy: @@ -136,7 +132,7 @@ You can put together sentences using this phrase.")) ;; By default, an operation propagates itself, but it may propagate another one instead. (defclass upward-operation (operation) ((upward-operation - :initform nil :initarg :downward-operation :reader upward-operation))) + :initform nil :initarg :downward-operation :reader upward-operation :allocation :class))) ;; For backward-compatibility reasons, a system inherits from module and is a child-component ;; so we must guard against this case. ASDF4: remove that. (defmethod component-depends-on ((o upward-operation) (c child-component)) @@ -145,13 +141,22 @@ You can put together sentences using this phrase.")) ;; Sibling operations propagate to siblings in the component hierarchy: ;; operation on a child depends-on operation on its parent. ;; By default, an operation propagates itself, but it may propagate another one instead. - (defclass sibling-operation (operation) - ((sibling-operation - :initform nil :initarg :sibling-operation :reader sibling-operation))) - (defmethod component-depends-on ((o sibling-operation) (c component)) - `((,(or (sibling-operation o) o) - ,@(loop :for dep :in (component-sibling-dependencies c) + (defclass sideway-operation (operation) + ((sideway-operation + :initform nil :initarg :sideway-operation :reader sideway-operation :allocation :class))) + (defmethod component-depends-on ((o sideway-operation) (c component)) + `((,(or (sideway-operation o) o) + ,@(loop :for dep :in (component-sideway-dependencies c) :collect (resolve-dependency-spec c dep))) + ,@(call-next-method))) + ;; Selfward operations propagate to themselves a sub-operation: + ;; they depend on some other operation being acted on the same component. + (defclass selfward-operation (operation) + ((selfward-operation + :initform nil :initarg :selfward-operation :reader selfward-operation :allocation :class))) + (defmethod component-depends-on ((o selfward-operation) (c component)) + `(,@(loop :for op :in (ensure-list (selfward-operation o)) + :collect `(,op ,c)) ,@(call-next-method)))) @@ -201,17 +206,16 @@ You can put together sentences using this phrase.")) (do-asdf-cache `(input-files ,operation ,component) (call-next-method))) - (defmethod input-files ((o operation) (c parent-component)) + (defmethod input-files ((o operation) (c component)) (declare (ignorable o c)) nil) - (defmethod input-files ((o operation) (c component)) - (or (loop* :for (dep-o) :in (component-self-dependencies o c) - :append (or (output-files dep-o c) (input-files dep-o c))) - ;; no non-trivial previous operations needed? - ;; I guess we work with the original source file, then - (if-let ((pathname (component-pathname c))) - (and (file-pathname-p pathname) (list pathname)))))) + (defmethod input-files ((o selfward-operation) (c component)) + `(,@(or (loop :for dep-o :in (ensure-list (selfward-operation o)) + :append (or (output-files dep-o c) (input-files dep-o c))) + (if-let ((pathname (component-pathname c))) + (and (file-pathname-p pathname) (list pathname)))) + ,@(call-next-method)))) ;;;; Done performing diff --git a/asdf.asd b/asdf.asd index c5e9b9fd..bcdea1c5 100644 --- a/asdf.asd +++ b/asdf.asd @@ -74,7 +74,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.32.12" ;; to be automatically updated by make bump-version + :version "2.32.13" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 ;; For most purposes, asdf itself specially counts as a builtin system. diff --git a/backward-interface.lisp b/backward-interface.lisp index fcf9c290..cbec61d8 100644 --- a/backward-interface.lisp +++ b/backward-interface.lisp @@ -34,7 +34,7 @@ (defun component-load-dependencies (component) ;; Old deprecated name for the same thing. Please update your software. - (component-sibling-dependencies component)) + (component-sideway-dependencies component)) (defgeneric operation-forced (operation)) ;; Used by swank.asd for swank-loader. (defmethod operation-forced ((o operation)) (getf (operation-original-initargs o) :force)) diff --git a/bundle.lisp b/bundle.lisp index 104f3540..05079aec 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -7,13 +7,14 @@ :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate) (:export - #:bundle-op #:bundle-op-build-args #:bundle-type #:bundle-system #:bundle-pathname-type - #:fasl-op #:load-fasl-op #:lib-op #:dll-op #:binary-op - #:monolithic-op #:monolithic-bundle-op #:bundlable-file-p #:direct-dependency-files - #:monolithic-binary-op #:monolithic-fasl-op #:monolithic-lib-op #:monolithic-dll-op - #:program-op - #:compiled-file #:precompiled-system #:prebuilt-system - #:operation-monolithic-p + #:bundle-op #:bundle-op-build-args #:bundle-type + #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files + #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p + #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op + #:lib-op #:monolithic-lib-op + #:dll-op #:monolithic-dll-op + #:binary-op #:monolithic-binary-op + #:program-op #:compiled-file #:precompiled-system #:prebuilt-system #:user-system-p #:user-system #:trivial-system-p #+ecl #:make-build #:register-pre-built-system @@ -29,27 +30,34 @@ #+mkcl (do-fasb :initarg :do-fasb :initform t :reader bundle-op-do-fasb-p) #+mkcl (do-static-library :initarg :do-static-library :initform t :reader bundle-op-do-static-library-p))) - (defclass fasl-op (bundle-op) - ;; create a single fasl for the entire library + ;; create a single fasl for the entire library + (defclass basic-fasl-op (bundle-op basic-compile-op) ((bundle-type :initform :fasl))) - - (defclass load-fasl-op (basic-load-op) - ;; load a single fasl for the entire library - ()) - - (defclass lib-op (bundle-op) - ;; On ECL: compile the system and produce linkable .a library for it. - ;; On others: just compile the system. + (defclass prepare-fasl-op (sideway-operation) + ((sideway-operation :initform 'load-fasl-op))) + (defclass fasl-op (basic-fasl-op selfward-operation) + ((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op)))) + (defclass load-fasl-op (basic-load-op selfward-operation) + ((selfward-operation :initform '(prepare-op fasl-op)))) + + ;; NB: since the monolithic-op's can't be sideway-operation's, + ;; if we wanted lib-op, dll-op, binary-op to be sideway-operation's, + ;; we'd have to have the monolithic-op not inherit from the main op, + ;; but instead inherit from a basic-FOO-op as with basic-fasl-op above. + + ;; On ECL: compile the system and produce linkable ".a" library for it. + ;; On others: just compile the system. + (defclass lib-op (bundle-op basic-compile-op) ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))) - (defclass dll-op (bundle-op) + (defclass dll-op (bundle-op basic-compile-op) ;; Link together all the dynamic library used by this system into a single one. ((bundle-type :initform :dll))) - (defclass binary-op (bundle-op) + (defclass binary-op (bundle-op basic-compile-op selfward-operation) ;; On ECL: produce lib and fasl for the system. ;; On "normal" Lisps: produce just the fasl. - ()) + ((selfward-operation :initform '(lib-op fasl-op)))) (defclass monolithic-op (operation) ()) ;; operation on a system and its dependencies @@ -57,25 +65,30 @@ ((prologue-code :accessor monolithic-op-prologue-code) (epilogue-code :accessor monolithic-op-epilogue-code))) - (defclass monolithic-binary-op (binary-op monolithic-bundle-op) + (defclass monolithic-binary-op (monolithic-bundle-op basic-compile-op sideway-operation selfward-operation) ;; On ECL: produce lib and fasl for combined system and dependencies. ;; On "normal" Lisps: produce an image file from system and dependencies. - ()) + ((selfward-operation :initform '(monolithic-fasl-op monolithic-lib-op)))) - (defclass monolithic-fasl-op (monolithic-bundle-op fasl-op) + (defclass monolithic-fasl-op (monolithic-bundle-op basic-fasl-op selfward-operation) ;; Create a single fasl for the system and its dependencies. - ()) + ((selfward-operation :initform 'load-fasl-op))) - (defclass monolithic-lib-op (monolithic-bundle-op lib-op) + (defclass monolithic-lib-op (monolithic-bundle-op basic-compile-op sideway-operation selfward-operation) ;; ECL: Create a single linkable library for the system and its dependencies. - ((bundle-type :initform :lib))) + ((bundle-type :initform :lib) + (selfward-operation :initform 'lib-op) + (sideway-operation :initform 'lib-op))) - (defclass monolithic-dll-op (monolithic-bundle-op dll-op) - ((bundle-type :initform :dll))) + (defclass monolithic-dll-op (monolithic-bundle-op basic-compile-op sideway-operation selfward-operation) + ((bundle-type :initform :dll) + (selfward-operation :initform 'dll-op) + (sideway-operation :initform 'dll-op))) - (defclass program-op (monolithic-bundle-op) + (defclass program-op (monolithic-bundle-op selfward-operation) ;; All: create an executable file from the system and its dependencies - ((bundle-type :initform :program))) + ((bundle-type :initform :program) + (selfward-operation :initform #+(or mkcl ecl) 'monolithic-lib-op #-(or mkcl ecl) 'load-op))) (defun bundle-pathname-type (bundle-type) (etypecase bundle-type @@ -195,47 +208,33 @@ (defmethod component-depends-on ((o monolithic-lib-op) (c system)) (declare (ignorable o)) `((lib-op ,@(required-components c :other-systems t :component-type 'system - :goal-operation 'load-op - :keep-operation 'compile-op)))) + :goal-operation (find-operation o 'load-op) + :keep-operation 'compile-op)) + ,@(call-next-method))) + (defmethod component-depends-on ((o monolithic-fasl-op) (c system)) (declare (ignorable o)) `((fasl-op ,@(required-components c :other-systems t :component-type 'system - :goal-operation 'load-fasl-op - :keep-operation 'fasl-op)))) - - (defmethod component-depends-on ((o program-op) (c system)) - (declare (ignorable o)) - #+(or ecl mkcl) (component-depends-on (make-operation 'monolithic-lib-op) c) - #-(or ecl mkcl) `((load-op ,c))) - - (defmethod component-depends-on ((o binary-op) (c system)) - (declare (ignorable o)) - `((fasl-op ,c) - (lib-op ,c))) - - (defmethod component-depends-on ((o monolithic-binary-op) (c system)) - `((,(find-operation o 'monolithic-fasl-op) ,c) - (,(find-operation o 'monolithic-lib-op) ,c))) + :goal-operation (find-operation o 'load-fasl-op) + :keep-operation 'fasl-op)) + ,@(call-next-method))) (defmethod component-depends-on ((o lib-op) (c system)) (declare (ignorable o)) `((compile-op ,@(required-components c :other-systems nil :component-type '(not system) - :goal-operation 'load-op - :keep-operation 'compile-op)))) + :goal-operation (find-operation o 'load-op) + :keep-operation 'compile-op)) + ,@(call-next-method))) + #-ecl (defmethod component-depends-on ((o fasl-op) (c system)) - (declare (ignorable o)) - #+ecl `((lib-op ,c)) - #-ecl - (component-depends-on (find-operation o 'lib-op) c)) + `(,@(component-depends-on (find-operation o 'lib-op) c) + ,@(call-next-method))) (defmethod component-depends-on ((o dll-op) c) - (component-depends-on (find-operation o 'lib-op) c)) - - (defmethod component-depends-on ((o bundle-op) c) - (declare (ignorable o c)) - nil) + `(,@(component-depends-on (find-operation o 'lib-op) c) + ,@(call-next-method))) (defmethod component-depends-on :around ((o bundle-op) (c component)) (declare (ignorable o c)) @@ -300,7 +299,7 @@ (with-upgradability () (defmethod component-depends-on ((o load-fasl-op) (c system)) (declare (ignorable o)) - `((,o ,@(loop :for dep :in (component-sibling-dependencies c) + `((,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) ,@(call-next-method))) diff --git a/component.lisp b/component.lisp index c31f5981..69ea1dcd 100644 --- a/component.lisp +++ b/component.lisp @@ -14,7 +14,7 @@ #:static-file #:doc-file #:html-file #:file-type #:source-file-type #:source-file-explicit-type ;; backward-compatibility - #:component-in-order-to #:component-sibling-dependencies + #:component-in-order-to #:component-sideway-dependencies #:component-if-feature #:around-compile-hook #:component-description #:component-long-description #:component-version #:version-satisfies @@ -33,7 +33,7 @@ #:components-by-name #:components #:children #:children-by-name #:default-component-class #:author #:maintainer #:licence #:source-file #:defsystem-depends-on - #:sibling-dependencies #:if-feature #:in-order-to #:inline-methods + #:sideway-dependencies #:if-feature #:in-order-to #:inline-methods #:relative-pathname #:absolute-pathname #:operation-times #:around-compile #:%encoding #:properties #:component-properties #:parent)) (in-package :asdf/component) @@ -77,7 +77,7 @@ another pathname in a degenerate way.")) (version :accessor component-version :initarg :version :initform nil) (description :accessor component-description :initarg :description :initform nil) (long-description :accessor component-long-description :initarg :long-description :initform nil) - (sibling-dependencies :accessor component-sibling-dependencies :initform nil) + (sideway-dependencies :accessor component-sideway-dependencies :initform nil) (if-feature :accessor component-if-feature :initform nil :initarg :if-feature) ;; In the ASDF object model, dependencies exist between *actions*, ;; where an action is a pair of an operation and a component. diff --git a/concatenate-source.lisp b/concatenate-source.lisp index d5542231..2cb3d5e2 100644 --- a/concatenate-source.lisp +++ b/concatenate-source.lisp @@ -22,21 +22,29 @@ ;;; Concatenate sources ;;; (with-upgradability () - (defclass concatenate-source-op (bundle-op) + (defclass basic-concatenate-source-op (bundle-op) ((bundle-type :initform "lisp"))) - (defclass load-concatenated-source-op (basic-load-op operation) - ((bundle-type :initform :no-output-file))) - (defclass compile-concatenated-source-op (basic-compile-op bundle-op) - ((bundle-type :initform :fasl))) - (defclass load-compiled-concatenated-source-op (basic-load-op operation) - ((bundle-type :initform :no-output-file))) + (defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ()) + (defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ()) + (defclass basic-load-compiled-concatenated-source-op (basic-load-op selfward-operation) ()) - (defclass monolithic-concatenate-source-op (concatenate-source-op monolithic-op) ()) - (defclass monolithic-load-concatenated-source-op (load-concatenated-source-op monolithic-op) ()) - (defclass monolithic-compile-concatenated-source-op (compile-concatenated-source-op monolithic-op) ()) - (defclass monolithic-load-compiled-concatenated-source-op (load-compiled-concatenated-source-op monolithic-op) ()) + (defclass concatenate-source-op (basic-concatenate-source-op) ()) + (defclass load-concatenated-source-op (basic-load-concatenated-source-op) + ((selfward-operation :initform '(prepare-op concatenate-source-op)))) + (defclass compile-concatenated-source-op (basic-compile-concatenated-source-op) + ((selfward-operation :initform '(prepare-op concatenate-source-op)))) + (defclass load-compiled-concatenated-source-op (basic-load-compiled-concatenated-source-op) + ((selfward-operation :initform '(prepare-op compile-concatenated-source-op)))) - (defmethod input-files ((operation concatenate-source-op) (s system)) + (defclass monolithic-concatenate-source-op (basic-concatenate-source-op monolithic-bundle-op) ()) + (defclass monolithic-load-concatenated-source-op (basic-load-concatenated-source-op) + ((selfward-operation :initform 'monolithic-concatenate-source-op))) + (defclass monolithic-compile-concatenated-source-op (basic-compile-concatenated-source-op) + ((selfward-operation :initform 'monolithic-concatenate-source-op))) + (defclass monolithic-load-compiled-concatenated-source-op (basic-load-compiled-concatenated-source-op) + ((selfward-operation :initform 'monolithic-compile-concatenated-source-op))) + + (defmethod input-files ((operation basic-concatenate-source-op) (s system)) (loop :with encoding = (or (component-encoding s) *default-encoding*) :with other-encodings = '() :with around-compile = (around-compile-hook s) @@ -62,43 +70,17 @@ (warn "~S uses around-compile hook ~A but has sources that use these hooks: ~A" operation around-compile other-around-compile)) (return inputs))) + (defmethod output-files ((o basic-compile-concatenated-source-op) (s system)) + (lisp-compilation-output-files o s)) - (defmethod input-files ((o load-concatenated-source-op) (s system)) - (direct-dependency-files o s)) - (defmethod input-files ((o compile-concatenated-source-op) (s system)) - (direct-dependency-files o s)) - (defmethod output-files ((o compile-concatenated-source-op) (s system)) - (let ((input (first (input-files o s)))) - (list (compile-file-pathname input)))) - (defmethod input-files ((o load-compiled-concatenated-source-op) (s system)) - (direct-dependency-files o s)) - - (defmethod perform ((o concatenate-source-op) (s system)) + (defmethod perform ((o basic-concatenate-source-op) (s system)) (let ((inputs (input-files o s)) (output (output-file o s))) (concatenate-files inputs output))) - (defmethod perform ((o load-concatenated-source-op) (s system)) + (defmethod perform ((o basic-load-concatenated-source-op) (s system)) (perform-lisp-load-source o s)) - (defmethod perform ((o compile-concatenated-source-op) (s system)) + (defmethod perform ((o basic-compile-concatenated-source-op) (s system)) (perform-lisp-compilation o s)) - (defmethod perform ((o load-compiled-concatenated-source-op) (s system)) - (perform-lisp-load-fasl o s)) - - (defmethod component-depends-on ((o concatenate-source-op) (s system)) - (declare (ignorable o s)) nil) - (defmethod component-depends-on ((o load-concatenated-source-op) (s system)) - (declare (ignorable o s)) `((prepare-op ,s) (concatenate-source-op ,s))) - (defmethod component-depends-on ((o compile-concatenated-source-op) (s system)) - (declare (ignorable o s)) `((concatenate-source-op ,s))) - (defmethod component-depends-on ((o load-compiled-concatenated-source-op) (s system)) - (declare (ignorable o s)) `((compile-concatenated-source-op ,s))) - - (defmethod component-depends-on ((o monolithic-concatenate-source-op) (s system)) - (declare (ignorable o s)) nil) - (defmethod component-depends-on ((o monolithic-load-concatenated-source-op) (s system)) - (declare (ignorable o s)) `((monolithic-concatenate-source-op ,s))) - (defmethod component-depends-on ((o monolithic-compile-concatenated-source-op) (s system)) - (declare (ignorable o s)) `((monolithic-concatenate-source-op ,s))) - (defmethod component-depends-on ((o monolithic-load-compiled-concatenated-source-op) (s system)) - (declare (ignorable o s)) `((monolithic-compile-concatenated-source-op ,s)))) + (defmethod perform ((o basic-load-compiled-concatenated-source-op) (s system)) + (perform-lisp-load-fasl o s))) diff --git a/defsystem.lisp b/defsystem.lisp index 7bcfbf49..87506eec 100644 --- a/defsystem.lisp +++ b/defsystem.lisp @@ -178,7 +178,7 @@ :when serial :do (setf previous-component name))) (compute-children-by-name component)) ;; Used by POIU. ASDF4: rename to component-depends-on? - (setf (component-sibling-dependencies component) depends-on) + (setf (component-sideway-dependencies component) depends-on) (%refresh-component-inline-methods component rest) (when if-component-dep-fails (%resolve-if-component-dep-fails if-component-dep-fails component)) diff --git a/header.lisp b/header.lisp index 91d8a90e..53f2d5dc 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.32.12: Another System Definition Facility. +;;; This is ASDF 2.32.13: 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 13e5cc27..29f8e3ab 100644 --- a/interface.lisp +++ b/interface.lisp @@ -24,20 +24,23 @@ #:search-for-system-definition #:find-component #:component-find-path #:compile-system #:load-system #:load-systems #:require-system #:test-system #:clear-system - #:operation #:upward-operation #:downward-operation #:make-operation + #:operation #:make-operation #:find-operation + #:upward-operation #:downward-operation #:sideway-operation #:selfward-operation #:build-system #:build-op #:load-op #:prepare-op #:compile-op #:prepare-source-op #:load-source-op #:test-op #:feature #:version #:version-satisfies #:upgrade-asdf #:implementation-identifier #:implementation-type #:hostname #:input-files #:output-files #:output-file #:perform - #:operation-done-p #:explain #:action-description #:component-sibling-dependencies + #:operation-done-p #:explain #:action-description #:component-sideway-dependencies #:needed-in-image-p ;; #:run-program ; we can't export it, because SB-GROVEL :use's both ASDF and SB-EXT. #:component-load-dependencies #:run-shell-command ; deprecated, do not use - #:bundle-op #:precompiled-system #:compiled-file #:bundle-system + #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system #+ecl #:make-build - #:program-op #:load-fasl-op #:fasl-op #:lib-op #:binary-op + #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op + #:lib-op #:dll-op #:binary-op #:program-op + #:monolithic-lib-op #:monolithic-dll-op #:monolithic-binary-op #:concatenate-source-op #:load-concatenated-source-op #:compile-concatenated-source-op diff --git a/lisp-action.lisp b/lisp-action.lisp index 43101f61..3da5237a 100644 --- a/lisp-action.lisp +++ b/lisp-action.lisp @@ -13,7 +13,8 @@ #:basic-load-op #:basic-compile-op #:compile-op-flags #:compile-op-proclamations #:load-op #:prepare-op #:compile-op #:test-op #:load-source-op #:prepare-source-op #:call-with-around-compile-hook - #:perform-lisp-compilation #:perform-lisp-load-fasl #:perform-lisp-load-source #:flags)) + #:perform-lisp-compilation #:perform-lisp-load-fasl #:perform-lisp-load-source + #:lisp-compilation-output-files #:flags)) (in-package :asdf/lisp-action) @@ -37,17 +38,23 @@ ;;; Our default operations: loading into the current lisp image (with-upgradability () - (defclass load-op (basic-load-op downward-operation sibling-operation) ()) - (defclass prepare-op (upward-operation sibling-operation) - ((sibling-operation :initform 'load-op :allocation :class))) - (defclass compile-op (basic-compile-op downward-operation) - ((downward-operation :initform 'load-op :allocation :class))) + (defclass prepare-op (upward-operation sideway-operation) + ((sideway-operation :initform 'load-op))) + (defclass load-op (basic-load-op downward-operation sideway-operation selfward-operation) + ;; NB: even though compile-op depends-on 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)))) + (defclass compile-op (basic-compile-op downward-operation selfward-operation) + ((selfward-operation :initform 'prepare-op) + (downward-operation :initform 'load-op))) - (defclass load-source-op (basic-load-op downward-operation) ()) - (defclass prepare-source-op (upward-operation sibling-operation) - ((sibling-operation :initform 'load-source-op :allocation :class))) + (defclass prepare-source-op (upward-operation sideway-operation) + ((sideway-operation :initform 'load-source-op))) + (defclass load-source-op (basic-load-op downward-operation selfward-operation) + ((selfward-operation :initform 'prepare-source-op))) - (defclass test-op (operation) ())) + (defclass test-op (selfward-operation) + ((selfward-operation :initform 'load-op)))) ;;;; prepare-op, compile-op and load-op @@ -123,8 +130,7 @@ (format s ":success~%")))))) (defmethod perform ((o compile-op) (c cl-source-file)) (perform-lisp-compilation o c)) - (defmethod output-files ((o compile-op) (c cl-source-file)) - (declare (ignorable o)) + (defun lisp-compilation-output-files (o c) (let* ((i (first (input-files o c))) (f (compile-file-pathname i #+mkcl :fasl-p #+mkcl t #+ecl :type #+ecl :fasl))) @@ -138,9 +144,8 @@ ,(compile-file-pathname i :fasl-p nil) ;; object file ,@(when (and *warnings-file-type* (not (builtin-system-p (component-system c)))) `(,(make-pathname :type *warnings-file-type* :defaults f)))))) - (defmethod component-depends-on ((o compile-op) (c component)) - (declare (ignorable o)) - `((prepare-op ,c) ,@(call-next-method))) + (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) @@ -190,13 +195,7 @@ (perform-lisp-load-fasl o c)) (defmethod perform ((o load-op) (c static-file)) (declare (ignorable o c)) - nil) - (defmethod component-depends-on ((o load-op) (c component)) - (declare (ignorable o)) - ;; NB: even though compile-op depends-on on prepare-op, - ;; it is not needed-in-image-p, whereas prepare-op is, - ;; so better not omit prepare-op and think it will happen. - `((prepare-op ,c) (compile-op ,c) ,@(call-next-method)))) + nil)) ;;;; prepare-source-op, load-source-op @@ -224,9 +223,6 @@ (defmethod action-description ((o load-source-op) (c parent-component)) (declare (ignorable o)) (format nil (compatfmt "~@<Loaded source of ~3i~_~A~@:>") c)) - (defmethod component-depends-on ((o load-source-op) (c component)) - (declare (ignorable o)) - `((prepare-source-op ,c) ,@(call-next-method))) (defun perform-lisp-load-source (o c) (call-with-around-compile-hook c #'(lambda () @@ -252,9 +248,5 @@ (defmethod operation-done-p ((o test-op) (c system)) "Testing a system is _never_ done." (declare (ignorable o c)) - nil) - (defmethod component-depends-on ((o test-op) (c system)) - (declare (ignorable o)) - `((load-op ,c) ,@(call-next-method)))) - + nil)) diff --git a/plan.lisp b/plan.lisp index ec217fbd..d82aba54 100644 --- a/plan.lisp +++ b/plan.lisp @@ -438,6 +438,7 @@ processed in order by OPERATE.")) (defmethod required-components (system &rest keys &key (goal-operation 'load-op) &allow-other-keys) (remove-duplicates - (mapcar 'cdr (apply 'traverse-sub-actions goal-operation system keys)) + (mapcar 'cdr (apply 'traverse-sub-actions goal-operation system + (remove-plist-key :goal-operation keys))) :from-end t))) diff --git a/test/test-concatenate-source.script b/test/test-concatenate-source.script index c6bc7c0e..703b836b 100644 --- a/test/test-concatenate-source.script +++ b/test/test-concatenate-source.script @@ -26,9 +26,9 @@ (output-files mcso sys) (input-files mccso sys)) ;; on ECL, we get un-equal pathnames. -(assert-pathname-equal - (output-file mccso sys) - (test-fasl "test-concatenate-source--all-systems.lisp")) +(assert-pathnames-equal + (output-files mccso sys) + (list (test-fasl "test-concatenate-source--all-systems.lisp"))) (assert-pathnames-equal (output-files mccso sys) (input-files mlccso sys)) diff --git a/test/test-utilities.script b/test/test-utilities.script index 26815de7..67371280 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -106,7 +106,7 @@ asdf/component:parent asdf/component:properties asdf/component:relative-pathname - asdf/component:sibling-dependencies + asdf/component:sideway-dependencies asdf/component:version asdf/lisp-action:flags asdf/operation:feature diff --git a/test/test-xach-update-bug.script b/test/test-xach-update-bug.script index 563fabb5..74e79c38 100644 --- a/test/test-xach-update-bug.script +++ b/test/test-xach-update-bug.script @@ -1,27 +1,47 @@ ;;; -*- Lisp -*- +(trace load compile-file perform-plan asdf/plan:traverse-action) ;; perform asdf/plan:compute-action-stamp +(setf asdf/cache:*asdf-cache* nil) ;; disable cache between those two very different compilations. -#+gcl (trace load compile-file asdf:perform asdf::perform-plan) -(progn - (let ((foo :test-asdf-location-change)) - (DBG "load foo. Should load from xach-foo-1/") - (setf *central-registry* (list (subpathname *test-directory* "xach-foo-1/"))) - (load-system foo) - (let ((foo1 (find-system foo)) - (loaded (find-symbol* :loaded :first-version))) - (assert-equal (symbol-value loaded) t) - (DBG "load foo again. Should not do anything -- already loaded") - (setf (symbol-value loaded) :test-that-we-dont-reload) - (load-system foo) - (assert-equal (symbol-value loaded) :test-that-we-dont-reload) +(defparameter foo :test-asdf-location-change) - (assert (not (find-package :second-version))) - (DBG "Now, change registry so foo is found from xach-foo-2/") - (setf *central-registry* (list (subpathname *test-directory* "xach-foo-2/"))) - (DBG "load foo yet again. It should see the pathname has changed and load it anew") - (load-system foo) - (let ((foo2 (find-system foo))) - (assert (eq foo1 foo2)) ;; the object should be the same - (assert (symbol-value (find-symbol* :loaded :second-version))) - (assert-equal 42 (symbol-call :second-version :wtf)))))) +(DBG "load foo. Should load from xach-foo-1/") +(setf *central-registry* (list (subpathname *test-directory* "xach-foo-1/"))) +(defparameter foo1 (find-system foo)) +(assert-pathname-equal + (subpathname *test-directory* "xach-foo-1/test-asdf-location-change.asd") + (system-source-file foo1)) +(assert-equal (mapcar 'component-name (component-children foo1)) '("a")) +(assert-pathname-equal + (subpathname *test-directory* "xach-foo-1/a.lisp") + (component-pathname (find-component foo1 "a"))) +(assert-equal nil (find-component foo1 "b")) +(load-system foo) +(defparameter loaded (find-symbol* :loaded :first-version)) +(assert-equal (symbol-value loaded) t) + +(DBG "load foo again. Should not do anything -- already loaded") +(setf (symbol-value loaded) :test-that-we-dont-reload) +(load-system foo) +(assert-equal (symbol-value loaded) :test-that-we-dont-reload) +(assert (not (find-package :second-version))) + +(DBG "Now, change registry so foo is found from xach-foo-2/") +(setf *central-registry* (list (subpathname *test-directory* "xach-foo-2/"))) +(defparameter foo2 (find-system foo)) +(assert (eq foo1 foo2)) ;; the object should be the same +(assert-equal (mapcar 'component-name (component-children foo2)) '("a" "b")) +(assert-pathname-equal + (subpathname *test-directory* "xach-foo-2/test-asdf-location-change.asd") + (system-source-file foo2)) +(assert-pathname-equal + (subpathname *test-directory* "xach-foo-2/a.lisp") + (component-pathname (find-component foo2 "a"))) +(assert-pathname-equal + (subpathname *test-directory* "xach-foo-2/b.lisp") + (component-pathname (find-component foo2 "b"))) +(DBG "load foo yet again. It should see the pathname has changed and load it anew") +(load-system foo) +(assert (symbol-value (find-symbol* :loaded :second-version))) +(assert-equal 42 (symbol-call :second-version :wtf)) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index b9113657..5c02f057 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -15,7 +15,8 @@ #:uiop-debug #:load-uiop-debug-utility #:*uiop-debug-utility* #:undefine-function #:undefine-functions #:defun* #:defgeneric* #:with-upgradability ;; (un)defining functions #:if-let ;; basic flow control - #:while-collecting #:appendf #:length=n-p #:remove-plist-keys #:remove-plist-key ;; lists and plists + #:while-collecting #:appendf #:length=n-p #:ensure-list ;; lists + #:remove-plist-keys #:remove-plist-key ;; plists #:emptyp ;; sequences #:strcat #:first-char #:last-char #:split-string ;; strings #:string-prefix-p #:string-enclosed-p #:string-suffix-p @@ -154,7 +155,11 @@ Returns two values: \(A B C\) and \(1 2 3\)." :for i :downfrom n :do (cond ((zerop i) (return (null l))) - ((not (consp l)) (return nil)))))) + ((not (consp l)) (return nil))))) + + (defun ensure-list (x) + (if (listp x) x (list x)))) + ;;; remove a key from a plist, i.e. for keyword argument cleanup (with-upgradability () diff --git a/upgrade.lisp b/upgrade.lisp index ea2759ba..a2df667d 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ;; "3.4.5.67" would be a development version in the official upstream 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 "2.32.12") + (asdf-version "2.32.13") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -69,7 +69,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO #:find-system #:system-source-file #:system-relative-pathname ;; system #:find-component ;; find-component #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action - #:component-depends-on #:component-self-dependencies #:operation-done-p + #:component-depends-on #:operation-done-p #:component-depends-on #:traverse ;; plan #:operate ;; operate #:parse-component-form ;; defsystem @@ -83,6 +83,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO (uninterned-symbols '(#:*asdf-revision* #:around #:asdf-method-combination #:split #:make-collector #:do-dep #:do-one-dep + #: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)) diff --git a/version.lisp-expr b/version.lisp-expr index f5f7a194..02ed374b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.32.12" +"2.32.13" -- GitLab