diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index a6f3d453032fa63dcd9b3674a18608d510b4aefb..1c66dae5314c85590e812bfd23a03d4f1b642e6d 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -133,6 +133,30 @@ ;;; Main parsing function (with-upgradability () + (defun* parse-dependency-def (dd) + (if (listp dd) + (case (first dd) + (:feature + (unless (= (length dd) 3) + (sysdef-error "Ill-formed feature dependency: ~s" dd)) + (let ((embedded (parse-dependency-def (third dd)))) + `(:feature ,(second dd) ,embedded))) + (:require + (unless (= (length dd) 2) + (sysdef-error "Ill-formed require dependency: ~s" dd)) + dd) + (:version + (unless (= (length dd) 3) + (sysdef-error "Ill-formed version dependency: ~s" dd)) + `(:version ,(coerce-name (second dd)) ,(third dd))) + (otherwise (sysdef-error "Ill-formed dependency: ~s" dd))) + (coerce-name dd))) + + (defun* parse-dependency-defs (dd-list) + "Parse the dependency defs in DD-LIST into canonical form by translating all +system names contained using COERCE-NAME. Return the result." + (mapcar 'parse-dependency-def dd-list)) + (defun* (parse-component-form) (parent options &key previous-serial-component) (destructuring-bind (type name &rest rest &key @@ -172,8 +196,11 @@ (component-pathname component) ; eagerly compute the absolute pathname (when (typep component 'system) ;; cache information for introspection - (setf (slot-value component 'depends-on) depends-on - (slot-value component 'weakly-depends-on) weakly-depends-on)) + (setf (slot-value component 'depends-on) + (parse-dependency-defs depends-on) + (slot-value component 'weakly-depends-on) + ;; these must be a list of systems, cannot be features or versioned systems + (mapcar 'coerce-name weakly-depends-on))) (let ((sysfile (system-source-file (component-system component)))) ;; requires the previous (when (and (typep component 'system) (not bspp)) (setf (builtin-system-p component) (lisp-implementation-pathname-p sysfile))) @@ -227,9 +254,15 @@ (make-instance 'system :name name :source-file source-file)))) (system (reset-system (cdr registered!) :name name :source-file source-file)) - (component-options (remove-plist-key :class options)) + (component-options + (remove-plist-keys '(:defsystem-depends-on :class) options)) (defsystem-dependencies (loop :for spec :in defsystem-depends-on :collect (resolve-dependency-spec nil spec)))) + ;; cache defsystem-depends-on in canonical form + (when defsystem-depends-on + (setf component-options + (append `(:defsystem-depends-on ,(parse-dependency-defs defsystem-depends-on)) + component-options))) (setf (gethash name *systems-being-defined*) system) (load-systems* defsystem-dependencies) ;; We change-class AFTER we loaded the defsystem-depends-on diff --git a/test/test-cache-for-introspection.script b/test/test-cache-for-introspection.script index 54bcc66506f6be10efd21444134c9ee640da96e9..058453b445ee164f7aa0a1b1b96df8d91a558b0e 100644 --- a/test/test-cache-for-introspection.script +++ b/test/test-cache-for-introspection.script @@ -16,6 +16,11 @@ :pathname #.*test-directory* :version "1.2") +(def-test-system :versioned-system-4 + :defsystem-depends-on ((:version test-asdf/2 "2.1")) + :pathname #.*test-directory* + :version "1.2") + (def-test-system :test-concatenate-source :depends-on (:file3-only) :components @@ -24,16 +29,29 @@ :components ((:file "file1") (:file "file4" :if-feature (:not :common-lisp)))))) +(def-test-system :test-structured-depends + :depends-on ((:version test-asdf/2 "2.1") :file3-only (:feature :foo (:require "blort"))) + :components + ((:file "file2" :depends-on ("foo")) + (:module "foo" :pathname "" + :components ((:file "file1") + (:file "file4" :if-feature (:not :common-lisp)))))) (DBG "The weakly-depends-on information is properly cached") -(assert (equal '(file3-only) (system-weakly-depends-on (find-system "test-weakly-depends-on")))) +(assert (equal '("file3-only") (system-weakly-depends-on (find-system "test-weakly-depends-on")))) (assert (null (system-weakly-depends-on (find-system "test-no-weakly-depends-on")))) (DBG "The depends-on information is properly cached") (assert (null (system-depends-on (find-system "test-no-weakly-depends-on")))) -(assert (equalp '(:file3-only) (system-depends-on (find-system "test-concatenate-source")))) +(assert (equalp '("file3-only") (system-depends-on (find-system "test-concatenate-source")))) (DBG "The defsystem-depends-on information is properly cached") (assert (null (system-defsystem-depends-on (find-system "test-no-weakly-depends-on")))) -(assert (equalp '((:version :test-asdf/2 "2.1")) (system-defsystem-depends-on (find-system :versioned-system-3)))) \ No newline at end of file +(assert (equalp '((:version "test-asdf/2" "2.1")) (system-defsystem-depends-on (find-system :versioned-system-3)))) +(assert (equalp '((:version "test-asdf/2" "2.1")) (system-defsystem-depends-on (find-system :versioned-system-4)))) + +(DBG "Test structured dependencies") +(assert (equalp + '((:version "test-asdf/2" "2.1") "file3-only" (:feature :foo (:require "blort"))) + (system-depends-on (find-system :test-structured-depends))))