Skip to content
Snippets Groups Projects
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
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment