From fcc68b59cbba706fb3349a966087b7d46dd40c3e Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@sift.info> Date: Tue, 18 Feb 2014 21:59:27 -0600 Subject: [PATCH] Fix for launchpad bug 1247662. Ensure that SYSTEM-DEFSYSTEM-DEPENDS-ON never gets SLOT-UNBOUND error. Also cache DEPENDS-ON and WEAKLY-DEPENDS-ON info from DEFSYSTEM. --- component.lisp | 4 ++- interface.lisp | 3 ++ parse-defsystem.lisp | 5 +++ system.lisp | 9 ++++-- test/test-cache-for-introspection.script | 39 ++++++++++++++++++++++++ test/test-utilities.script | 6 +++- 6 files changed, 62 insertions(+), 4 deletions(-) create mode 100644 test/test-cache-for-introspection.script diff --git a/component.lisp b/component.lisp index 33578ab2..854b63dd 100644 --- a/component.lisp +++ b/component.lisp @@ -36,7 +36,9 @@ #:name #:version #:description #:long-description #:author #:maintainer #:licence #:components-by-name #:components #:children #:children-by-name #:default-component-class - #:author #:maintainer #:licence #:source-file #:defsystem-depends-on + #:author #:maintainer #:licence #:source-file + ;; the following retained for backward compatibility. + #:defsystem-depends-on #:sideway-dependencies #:if-feature #:in-order-to #:inline-methods #:relative-pathname #:absolute-pathname #:operation-times #:around-compile #:%encoding #:properties #:component-properties #:parent)) diff --git a/interface.lisp b/interface.lisp index b92a1202..2468aabf 100644 --- a/interface.lisp +++ b/interface.lisp @@ -94,6 +94,9 @@ #:system-long-name #:system-source-control #:map-systems + #:system-defsystem-depends-on + #:system-depends-on + #:system-weakly-depends-on #:*system-definition-search-functions* ; variables #:*central-registry* diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index 129bc558..40306715 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -8,6 +8,7 @@ :asdf/component :asdf/system :asdf/cache :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate :asdf/backward-internals) + (:import-from :asdf/system #:depends-on #:weakly-depends-on) (:export #:defsystem #:register-system-definition #:class-for-type #:*default-component-class* @@ -169,6 +170,10 @@ (apply 'reinitialize-instance component args) (setf component (apply 'make-instance class args))) (component-pathname component) ; eagerly compute the absolute pathname + ;; cache information for introspection + (when (typep component 'system) + (setf (slot-value component 'depends-on) depends-on + (slot-value component 'weakly-depends-on) 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))) diff --git a/system.lisp b/system.lisp index 02eab6bb..f4505ac9 100644 --- a/system.lisp +++ b/system.lisp @@ -10,7 +10,7 @@ #:reset-system #:system-description #:system-long-description #:system-author #:system-maintainer #:system-licence #:system-license - #:system-defsystem-depends-on + #:system-defsystem-depends-on #:system-depends-on #:system-weakly-depends-on #:component-build-pathname #:build-pathname #:component-entry-point #:entry-point #:homepage #:system-homepage @@ -62,7 +62,12 @@ (entry-point :initform nil :initarg :entry-point :accessor component-entry-point) (source-file :initform nil :initarg :source-file :accessor system-source-file) - (defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on))) + (defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on + :initform nil) + ;; these two are specially set in parse-component-form, so have no :INITARGs. + (depends-on :reader system-depends-on :initform nil) + (weakly-depends-on :reader system-weakly-depends-on :initform nil) + )) (defun reset-system (system &rest keys &key &allow-other-keys) (change-class (change-class system 'proto-system) 'system) diff --git a/test/test-cache-for-introspection.script b/test/test-cache-for-introspection.script new file mode 100644 index 00000000..54bcc665 --- /dev/null +++ b/test/test-cache-for-introspection.script @@ -0,0 +1,39 @@ +;;; -*- Lisp -*- + +;;;--------------------------------------------------------------------------- +;;; Test to see that we are correctly caching information about system +;;; definitions +;;;--------------------------------------------------------------------------- +(def-test-system test-weakly-depends-on + :weakly-depends-on (file3-only) + :components ((:file "file1"))) + +(def-test-system test-no-weakly-depends-on + :components ((:file "file1"))) + +(def-test-system :versioned-system-3 + :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 + ((: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 (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")))) + +(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 diff --git a/test/test-utilities.script b/test/test-utilities.script index 79115d37..6d0b7c4c 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -93,7 +93,9 @@ asdf/component:components asdf/component:components-by-name asdf/component:default-component-class - asdf/component:defsystem-depends-on + ;; the following is here only for backward compatibility; should be in + ;; asdf/system. [2014/02/20:rpg] + asdf/component:defsystem-depends-on asdf/component:description asdf/component:%encoding asdf/component:if-feature @@ -124,6 +126,8 @@ asdf/plan:visiting-action-list asdf/system:bug-tracker asdf/system:build-pathname + asdf/system:system-defsystem-depends-on + asdf/system:system-weakly-depends-on asdf/system:entry-point asdf/system:homepage asdf/system:long-name -- GitLab