Commit dc430eeb authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

Fix for launchpad ticket 1206173, with test case.

parent 8dac885c
Loading
Loading
Loading
Loading
+23 −2
Original line number Diff line number Diff line
@@ -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)
+1 −7
Original line number Diff line number Diff line
@@ -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))
+1 −10
Original line number Diff line number Diff line
@@ -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)))
+11 −0
Original line number Diff line number Diff line
;;; -*- 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)))
+4 −0
Original line number Diff line number Diff line
(defsystem duplicate-components
  :components
  ((:file "foo")
   (:file "foo")))