Commit 3ba2b977 authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

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).
parent 3ca76445
Loading
Loading
Loading
Loading
+36 −3
Original line number Diff line number Diff line
@@ -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
+21 −3
Original line number Diff line number Diff line
@@ -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))))