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