From dc430eeb094b15001bbeef363c7eb827edd2db82 Mon Sep 17 00:00:00 2001
From: "Robert P. Goldman" <rpgoldman@gmail.com>
Date: Tue, 30 Jul 2013 14:40:02 -0500
Subject: [PATCH] Fix for launchpad ticket 1206173, with test case.

---
 component.lisp                        | 25 +++++++++++++++++++++++--
 defsystem.lisp                        |  8 +-------
 find-system.lisp                      | 11 +----------
 test/duplicate-components-test.script | 11 +++++++++++
 test/duplicate-components.asd         |  4 ++++
 5 files changed, 40 insertions(+), 19 deletions(-)
 create mode 100644 test/duplicate-components-test.script
 create mode 100644 test/duplicate-components.asd

diff --git a/component.lisp b/component.lisp
index 34b0e81e1..cbc4b8a22 100644
--- a/component.lisp
+++ b/component.lisp
@@ -2,7 +2,7 @@
 ;;;; Components
 
 (asdf/package:define-package :asdf/component
-  (:recycle :asdf/component :asdf)
+  (:recycle :asdf/component :asdf/defsystem :asdf :asdf/find-system)
   (:use :asdf/common-lisp :asdf/driver :asdf/upgrade)
   (:export
    #:component #:component-find-path
@@ -28,6 +28,10 @@
    #:module-components ;; backward-compatibility. DO NOT USE.
    #:sub-components
 
+   ;; conditions
+   #:system-definition-error ;; top level, moved here because this is the earliest place for it.
+   #:duplicate-names
+
    ;; Internals we'd like to share with the ASDF package, especially for upgrade purposes
    #:name #:version #:description #:long-description #:author #:maintainer #:licence
    #:components-by-name #:components
@@ -61,7 +65,24 @@ another pathname in a degenerate way."))
 
   ;; Backward compatible way of computing the FILE-TYPE of a component.
   ;; TODO: find users, have them stop using that, remove it for ASDF4.
-  (defgeneric (source-file-type) (component system)))
+  (defgeneric (source-file-type) (component system))
+
+  (define-condition system-definition-error (error) ()
+    ;; [this use of :report should be redundant, but unfortunately it's not.
+    ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-function
+    ;; over print-object; this is always conditions::%print-condition for
+    ;; condition objects, which in turn does inheritance of :report options at
+    ;; run-time.  fortunately, inheritance means we only need this kludge here in
+    ;; order to fix all conditions that build on it.  -- rgr, 28-Jul-02.]
+    #+cmu (:report print-object))
+
+  (define-condition duplicate-names (system-definition-error)
+    ((name :initarg :name :reader duplicate-names-name))
+    (:report (lambda (c s)
+               (format s (compatfmt "~@<Error while defining system: multiple components are given same name ~S~@:>")
+                       (duplicate-names-name c))))))
+
+
 
 (when-upgrading (:when (find-class 'component nil))
   (defmethod reinitialize-instance :after ((c component) &rest initargs &key)
diff --git a/defsystem.lisp b/defsystem.lisp
index f31d63355..6349bac0b 100644
--- a/defsystem.lisp
+++ b/defsystem.lisp
@@ -11,7 +11,7 @@
    #:defsystem #:register-system-definition
    #:class-for-type #:*default-component-class*
    #:determine-system-directory #:parse-component-form
-   #:duplicate-names #:non-toplevel-system #:non-system-system
+   #:non-toplevel-system #:non-system-system
    #:sysdef-error-component #:check-component-input))
 (in-package :asdf/defsystem)
 
@@ -66,12 +66,6 @@
 
 ;;; Check inputs
 (with-upgradability ()
-  (define-condition duplicate-names (system-definition-error)
-    ((name :initarg :name :reader duplicate-names-name))
-    (:report (lambda (c s)
-               (format s (compatfmt "~@<Error while defining system: multiple components are given same name ~S~@:>")
-                       (duplicate-names-name c)))))
-
   (define-condition non-system-system (system-definition-error)
     ((name :initarg :name :reader non-system-system-name)
      (class-name :initarg :class-name :reader non-system-system-class-name))
diff --git a/find-system.lisp b/find-system.lisp
index 0004789fd..cee8d4a75 100644
--- a/find-system.lisp
+++ b/find-system.lisp
@@ -10,7 +10,7 @@
    #:coerce-name #:primary-system-name #:coerce-filename
    #:find-system #:locate-system #:load-asd #:with-system-definitions
    #:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems
-   #:system-definition-error #:missing-component #:missing-requires #:missing-parent
+   #:missing-component #:missing-requires #:missing-parent
    #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error
    #:load-system-definition-error #:error-name #:error-pathname #:error-condition
    #:*system-definition-search-functions* #:search-for-system-definition
@@ -26,15 +26,6 @@
 (with-upgradability ()
   (declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference
 
-  (define-condition system-definition-error (error) ()
-    ;; [this use of :report should be redundant, but unfortunately it's not.
-    ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-function
-    ;; over print-object; this is always conditions::%print-condition for
-    ;; condition objects, which in turn does inheritance of :report options at
-    ;; run-time.  fortunately, inheritance means we only need this kludge here in
-    ;; order to fix all conditions that build on it.  -- rgr, 28-Jul-02.]
-    #+cmu (:report print-object))
-
   (define-condition missing-component (system-definition-error)
     ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires)
      (parent :initform nil :reader missing-parent :initarg :parent)))
diff --git a/test/duplicate-components-test.script b/test/duplicate-components-test.script
new file mode 100644
index 000000000..eb75cab68
--- /dev/null
+++ b/test/duplicate-components-test.script
@@ -0,0 +1,11 @@
+;;; -*- Lisp -*-
+
+(handler-case (asdf:find-system "duplicate-components")
+  (asdf:duplicate-names (x) (declare (ignore x)) t)
+  (asdf:load-system-definition-error (x)
+    (if (and (asdf/find-system::error-condition x)
+             (typep (asdf/find-system::error-condition x) 'asdf:duplicate-names))
+        t
+        (error "LOAD-SYSTEM-DEFINITION-ERROR not as expected (no contained DUPLICATE-NAMES error).")))
+  (:no-error (x)
+    (error "FIND-SYSTEM of duplicate-components returned ~S instead of raising DUPLICATE-NAMES error." x)))
diff --git a/test/duplicate-components.asd b/test/duplicate-components.asd
new file mode 100644
index 000000000..fb14a2194
--- /dev/null
+++ b/test/duplicate-components.asd
@@ -0,0 +1,4 @@
+(defsystem duplicate-components
+  :components
+  ((:file "foo")
+   (:file "foo")))
-- 
GitLab