From 3ba2b9773b36c9d3d87a8d3888f63c8de9da24f7 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@gmail.com> Date: Sun, 23 Feb 2014 10:24:35 -0600 Subject: [PATCH] Putting introspection functions in canonical form. SYSTEM-DEFSYSTEM-DEPENDS-ON, SYSTEM-DEPENDS-ON, and SYSTEM-WEAKLY-DEPENDS-ON now always return s-expressions with system names represented as downcased caps (per COERCE-NAME). --- parse-defsystem.lisp | 39 ++++++++++++++++++++++-- test/test-cache-for-introspection.script | 24 +++++++++++++-- 2 files changed, 57 insertions(+), 6 deletions(-) diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index a6f3d453..1c66dae5 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 54bcc665..058453b4 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)))) -- GitLab