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