Skip to content
Snippets Groups Projects
Commit dc430eeb authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

Fix for launchpad ticket 1206173, with test case.

parent 8dac885c
No related branches found
No related tags found
No related merge requests found
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
;;;; Components ;;;; Components
(asdf/package:define-package :asdf/component (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) (:use :asdf/common-lisp :asdf/driver :asdf/upgrade)
(:export (:export
#:component #:component-find-path #:component #:component-find-path
...@@ -28,6 +28,10 @@ ...@@ -28,6 +28,10 @@
#:module-components ;; backward-compatibility. DO NOT USE. #:module-components ;; backward-compatibility. DO NOT USE.
#:sub-components #: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 ;; Internals we'd like to share with the ASDF package, especially for upgrade purposes
#:name #:version #:description #:long-description #:author #:maintainer #:licence #:name #:version #:description #:long-description #:author #:maintainer #:licence
#:components-by-name #:components #:components-by-name #:components
...@@ -61,7 +65,24 @@ another pathname in a degenerate way.")) ...@@ -61,7 +65,24 @@ another pathname in a degenerate way."))
;; Backward compatible way of computing the FILE-TYPE of a component. ;; Backward compatible way of computing the FILE-TYPE of a component.
;; TODO: find users, have them stop using that, remove it for ASDF4. ;; 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)) (when-upgrading (:when (find-class 'component nil))
(defmethod reinitialize-instance :after ((c component) &rest initargs &key) (defmethod reinitialize-instance :after ((c component) &rest initargs &key)
......
...@@ -11,7 +11,7 @@ ...@@ -11,7 +11,7 @@
#:defsystem #:register-system-definition #:defsystem #:register-system-definition
#:class-for-type #:*default-component-class* #:class-for-type #:*default-component-class*
#:determine-system-directory #:parse-component-form #: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)) #:sysdef-error-component #:check-component-input))
(in-package :asdf/defsystem) (in-package :asdf/defsystem)
...@@ -66,12 +66,6 @@ ...@@ -66,12 +66,6 @@
;;; Check inputs ;;; Check inputs
(with-upgradability () (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) (define-condition non-system-system (system-definition-error)
((name :initarg :name :reader non-system-system-name) ((name :initarg :name :reader non-system-system-name)
(class-name :initarg :class-name :reader non-system-system-class-name)) (class-name :initarg :class-name :reader non-system-system-class-name))
......
...@@ -10,7 +10,7 @@ ...@@ -10,7 +10,7 @@
#:coerce-name #:primary-system-name #:coerce-filename #:coerce-name #:primary-system-name #:coerce-filename
#:find-system #:locate-system #:load-asd #:with-system-definitions #:find-system #:locate-system #:load-asd #:with-system-definitions
#:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems #: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 #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error
#:load-system-definition-error #:error-name #:error-pathname #:error-condition #:load-system-definition-error #:error-name #:error-pathname #:error-condition
#:*system-definition-search-functions* #:search-for-system-definition #:*system-definition-search-functions* #:search-for-system-definition
...@@ -26,15 +26,6 @@ ...@@ -26,15 +26,6 @@
(with-upgradability () (with-upgradability ()
(declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference (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) (define-condition missing-component (system-definition-error)
((requires :initform "(unnamed)" :reader missing-requires :initarg :requires) ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires)
(parent :initform nil :reader missing-parent :initarg :parent))) (parent :initform nil :reader missing-parent :initarg :parent)))
......
;;; -*- 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)))
(defsystem duplicate-components
:components
((:file "foo")
(:file "foo")))
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