Changeset 13258 for trunk/abcl/src/org


Ignore:
Timestamp:
03/28/11 14:47:46 (10 years ago)
Author:
Mark Evenson
Message:

Update to ASDF-2.014.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r13253 r13258  
    11;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
    2 ;;; This is ASDF 2.013: Another System Definition Facility.
     2;;; This is ASDF 2.014: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    6969(in-package :asdf)
    7070
     71;;; Strip out formating that is not supported on Genera.
     72(defmacro compatfmt (format)
     73  #-genera format
     74  #+genera
     75  (let ((r '(("~@<" . "")
     76       ("; ~@;" . "; ")
     77       ("~3i~_" . "")
     78       ("~@:>" . "")
     79       ("~:>" . ""))))
     80    (dolist (i r)
     81      (loop :for found = (search (car i) format) :while found :do
     82        (setf format (concatenate 'simple-string (subseq format 0 found)
     83                                  (cdr i)
     84                                  (subseq format (+ found (length (car i))))))))
     85    format))
     86
    7187;;;; Create packages in a way that is compatible with hot-upgrade.
    7288;;;; See https://bugs.launchpad.net/asdf/+bug/485687
     
    84100         ;; "2.345.0.7" would be your seventh local modification of official release 2.345
    85101         ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
    86          (asdf-version "2.013")
     102         (asdf-version "2.014")
    87103         (existing-asdf (fboundp 'find-system))
    88104         (existing-version *asdf-version*)
     
    91107      (when existing-asdf
    92108        (format *trace-output*
    93          "~&; Upgrading ASDF package ~@[from version ~A ~]to version ~A~%"
    94          existing-version asdf-version))
     109    (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%")
     110    existing-version asdf-version))
    95111      (labels
    96112          ((present-symbol-p (symbol package)
    97              (member (nth-value 1 (find-symbol symbol package)) '(:internal :external)))
     113             (member (nth-value 1 (find-sym symbol package)) '(:internal :external)))
    98114           (present-symbols (package)
    99115             ;; #-genera (loop :for s :being :the :present-symbols :in package :collect s) #+genera
     
    423439(defun* normalize-pathname-directory-component (directory)
    424440  (cond
    425     #-(or sbcl cmu)
     441    #-(or cmu sbcl scl)
    426442    ((stringp directory) `(:absolute ,directory) directory)
    427443    #+gcl
     
    432448     directory)
    433449    (t
    434      (error "Unrecognized pathname directory component ~S" directory))))
     450     (error (compatfmt "~@<Unrecognized pathname directory component ~S~@:>") directory))))
    435451
    436452(defun* merge-pathname-directory-components (specified defaults)
     
    462478  (when (null specified) (return-from merge-pathnames* defaults))
    463479  (when (null defaults) (return-from merge-pathnames* specified))
     480  #+scl
     481  (ext:resolve-pathname specified defaults)
     482  #-scl
    464483  (let* ((specified (pathname specified))
    465484         (defaults (pathname defaults))
     
    510529  (and (stringp s) (plusp (length s)) (char s (1- (length s)))))
    511530
    512 (defun* errfmt (out format-string &rest format-args)
    513   (declare (dynamic-extent format-args))
    514   (apply #'format out
    515          #-genera (format nil "~~@<~A~~:>" format-string) #+genera format-string
    516          format-args))
    517 
     531   
    518532(defun* asdf-message (format-string &rest format-args)
    519533  (declare (dynamic-extent format-args))
    520   (apply #'errfmt *verbose-out* format-string format-args))
     534  (apply #'format *verbose-out* format-string format-args))
    521535
    522536(defun* split-string (string &key max (separator '(#\Space #\Tab)))
     
    570584  (check-type s string)
    571585  (when (find #\: s)
    572     (error "a portable ASDF pathname designator cannot include a #\: character: ~S" s))
     586    (error (compatfmt "~@<A portable ASDF pathname designator cannot include a #\: character: ~3i~_~S~@:>") s))
    573587  (let* ((components (split-string s :separator "/"))
    574588         (last-comp (car (last components))))
     
    578592                (progn
    579593                  (when force-relative
    580                     (error "absolute pathname designator not allowed: ~S" s))
     594                    (error (compatfmt "~@<Absolute pathname designator not allowed: ~3i~_~S~@:>") s))
    581595                  (values :absolute (cdr components)))
    582596                (values :relative nil))
     
    649663    (ensure-directory-pathname (pathname pathspec)))
    650664   ((not (pathnamep pathspec))
    651     (error "Invalid pathname designator ~S" pathspec))
     665    (error (compatfmt "~@<Invalid pathname designator ~S~@:>") pathspec))
    652666   ((wild-pathname-p pathspec)
    653     (error "Can't reliably convert wild pathname ~S" pathspec))
     667    (error (compatfmt "~@<Can't reliably convert wild pathname ~3i~_~S~@:>") pathspec))
    654668   ((directory-pathname-p pathspec)
    655669    pathspec)
     
    717731
    718732(defun* pathname-root (pathname)
    719   (make-pathname :host (pathname-host pathname)
    720                  :device (pathname-device pathname)
    721                  :directory '(:absolute)
    722                  :name nil :type nil :version nil))
     733  (make-pathname :directory '(:absolute)
     734                 :name nil :type nil :version nil
     735                 :defaults pathname ;; host device, and on scl scheme scheme-specific-part port username password
     736                 . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
    723737
    724738(defun* find-symbol* (s p)
     
    745759      (let ((found (probe-file* p)))
    746760        (when found (return found)))
    747       #-(or sbcl cmu) (when (stringp directory) (return p))
     761      #-(or cmu sbcl scl) (when (stringp directory) (return p))
    748762      (when (not (eq :absolute (car directory))) (return p))
    749763      (let ((sofar (probe-file* (pathname-root p))))
     
    793807  (merge-pathnames* *wild-path* path))
    794808
     809#-scl
    795810(defun directory-separator-for-host (&optional (pathname *default-pathname-defaults*))
    796811  (let ((foo (make-pathname :directory '(:absolute "FOO") :defaults pathname)))
    797812    (last-char (namestring foo))))
    798813
     814#-scl
    799815(defun* directorize-pathname-host-device (pathname)
    800816  (let* ((root (pathname-root pathname))
     
    816832        (translate-pathname absolute-pathname wild-root (wilden new-base))))))
    817833
     834#+scl
     835(defun* directorize-pathname-host-device (pathname)
     836  (let ((scheme (ext:pathname-scheme pathname))
     837  (host (pathname-host pathname))
     838  (port (ext:pathname-port pathname))
     839  (directory (pathname-directory pathname)))
     840    (flet ((not-unspecific (component)
     841       (and (not (eq component :unspecific)) component)))
     842      (cond ((or (not-unspecific port)
     843     (and (not-unspecific host) (plusp (length host)))
     844     (not-unspecific scheme))
     845       (let ((prefix ""))
     846         (when (not-unspecific port)
     847     (setf prefix (format nil ":~D" port)))
     848         (when (and (not-unspecific host) (plusp (length host)))
     849     (setf prefix (concatenate 'string host prefix)))
     850         (setf prefix (concatenate 'string ":" prefix))
     851         (when (not-unspecific scheme)
     852         (setf prefix (concatenate 'string scheme prefix)))
     853         (assert (and directory (eq (first directory) :absolute)))
     854         (make-pathname :directory `(:absolute ,prefix ,@(rest directory))
     855            :defaults pathname)))
     856      (t
     857       pathname)))))
     858
    818859;;;; -------------------------------------------------------------------------
    819860;;;; ASDF Interface, in terms of generic functions.
     
    931972         (declare (ignorable deleted plist))
    932973         (when (or *asdf-verbose* *load-verbose*)
    933            (asdf-message "~&; Updating ~A for ASDF ~A~%" m ,(asdf-version)))
     974           (asdf-message (compatfmt "~&~@<; ~@;Updating ~A for ASDF ~A~@:>~%")
     975       m ,(asdf-version)))
    934976         (when (member 'components-by-name added)
    935977           (compute-module-components-by-name m))
     
    9701012   (format-arguments :initarg :format-arguments :reader format-arguments))
    9711013  (:report (lambda (c s)
    972                (apply #'errfmt s (format-control c) (format-arguments c)))))
     1014               (apply #'format s (format-control c) (format-arguments c)))))
    9731015
    9741016(define-condition load-system-definition-error (system-definition-error)
     
    9771019   (condition :initarg :condition :reader error-condition))
    9781020  (:report (lambda (c s)
    979        (errfmt s "Error while trying to load definition for system ~A from pathname ~A: ~A"
     1021       (format s (compatfmt "~@<Error while trying to load definition for system ~A from pathname ~A: ~3i~_~A~@:>")
    9801022         (error-name c) (error-pathname c) (error-condition c)))))
    9811023
     
    9831025  ((components :initarg :components :reader circular-dependency-components))
    9841026  (:report (lambda (c s)
    985        (errfmt s "Circular dependency: ~S" (circular-dependency-components c)))))
     1027       (format s (compatfmt "~@<Circular dependency: ~3i~_~S~@:>")
     1028         (circular-dependency-components c)))))
    9861029
    9871030(define-condition duplicate-names (system-definition-error)
    9881031  ((name :initarg :name :reader duplicate-names-name))
    9891032  (:report (lambda (c s)
    990        (errfmt s "Error while defining system: multiple components are given same name ~A"
     1033       (format s (compatfmt "~@<Error while defining system: multiple components are given same name ~A~@:>")
    9911034         (duplicate-names-name c)))))
    9921035
     
    10091052   (operation :reader error-operation :initarg :operation))
    10101053  (:report (lambda (c s)
    1011                (errfmt s "erred while invoking ~A on ~A"
     1054               (format s (compatfmt "~@<Error while invoking ~A on ~A~@:>")
    10121055                       (error-operation c) (error-component c)))))
    10131056(define-condition compile-error (operation-error) ())
     
    10211064   (arguments :reader condition-arguments :initarg :arguments :initform nil))
    10221065  (:report (lambda (c s)
    1023                (errfmt s "~? (will be skipped)"
     1066               (format s (compatfmt "~@<~? (will be skipped)~@:>")
    10241067                       (condition-format c)
    10251068                       (list* (condition-form c) (condition-location c)
    10261069                              (condition-arguments c))))))
    10271070(define-condition invalid-source-registry (invalid-configuration warning)
    1028   ((format :initform "invalid source registry ~S~@[ in ~S~]~@{ ~@?~}")))
     1071  ((format :initform (compatfmt "~@<Invalid source registry ~S~@[ in ~S~]~@{ ~@?~}~@:>"))))
    10291072(define-condition invalid-output-translation (invalid-configuration warning)
    1030   ((format :initform "invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}")))
     1073  ((format :initform (compatfmt "~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>"))))
    10311074
    10321075(defclass component ()
     
    10921135
    10931136(defmethod print-object ((c missing-dependency) s)
    1094   (format s "~A, required by ~A"
     1137  (format s (compatfmt "~@<~A, required by ~A~@:>")
    10951138          (call-next-method c nil) (missing-required-by c)))
    10961139
     
    11021145
    11031146(defmethod print-object ((c missing-component) s)
    1104   (format s "component ~S not found~@[ in ~A~]"
     1147  (format s (compatfmt "~@<Component ~S not found~@[ in ~A~]~@:>")
    11051148          (missing-requires c)
    11061149          (when (missing-parent c)
     
    11081151
    11091152(defmethod print-object ((c missing-component-of-version) s)
    1110   (format s "component ~S does not match version ~A~@[ in ~A~]"
     1153  (format s (compatfmt "~@<Component ~S does not match version ~A~@[ in ~A~]~@:>")
    11111154          (missing-requires c)
    11121155          (missing-version c)
     
    11681211             (pathname-directory-pathname (component-parent-pathname component)))))
    11691212        (unless (or (null pathname) (absolute-pathname-p pathname))
    1170           (error "Invalid relative pathname ~S for component ~S"
     1213          (error (compatfmt "~@<Invalid relative pathname ~S for component ~S~@:>")
    11711214                 pathname (component-find-path component)))
    11721215        (setf (slot-value component 'absolute-pathname) pathname)
     
    12371280    (symbol (string-downcase (symbol-name name)))
    12381281    (string name)
    1239     (t (sysdef-error "invalid component designator ~A" name))))
     1282    (t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name))))
    12401283
    12411284(defun* system-registered-p (name)
     
    13301373                            (let* ((*print-circle* nil)
    13311374                                   (message
    1332                                     (errfmt nil
    1333                                             "While searching for system ~S: ~S evaluated to ~S which is not a directory."
     1375                                    (format nil
     1376                                            (compatfmt "~@<While searching for system ~S: ~3i~_~S evaluated to ~S which is not a directory.~@:>")
    13341377                                            system dir defaults)))
    13351378                              (error message))
     
    13391382                          (coerce-entry-to-directory ()
    13401383                            :report (lambda (s)
    1341               (errfmt s "Coerce entry to ~a, replace ~a and continue."
     1384              (format s (compatfmt "~@<Coerce entry to ~a, replace ~a and continue.~@:>")
    13421385                (ensure-directory-pathname defaults) dir))
    13431386                            (push (cons dir (ensure-directory-pathname defaults)) to-replace))))))))
     
    13751418      (progn
    13761419        (when (and pathname *asdf-verbose*)
    1377           (warn "Missing FILE-WRITE-DATE for ~S: treating it as zero."
     1420          (warn (compatfmt "~@<Missing FILE-WRITE-DATE for ~S, treating it as zero.~@:>")
    13781421                pathname))
    13791422        0)))
     
    13921435                                :condition condition))))
    13931436           (let ((*package* package))
    1394              (asdf-message
    1395               "~&; Loading system definition from ~A into ~A~%"
    1396               pathname package)
     1437             (asdf-message (compatfmt "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%")
     1438         pathname package)
    13971439             (load pathname)))
    13981440      (delete-package package))))
     
    14191461
    14201462(defun* register-system (name system)
    1421   (asdf-message "~&; Registering ~A as ~A~%" system name)
    1422   (setf (gethash (coerce-name name) *defined-systems*)
    1423         (cons (get-universal-time) system)))
     1463  (setf name (coerce-name name))
     1464  (assert (equal name (component-name system)))
     1465  (asdf-message (compatfmt "~&~@<; ~@;Registering ~3i~_~A~@:>~%") system)
     1466  (setf (gethash name *defined-systems*) (cons (get-universal-time) system)))
    14241467
    14251468(defun* find-system-fallback (requested fallback &rest keys &key source-file &allow-other-keys)
     
    14971540  (source-file-explicit-type component))
    14981541
    1499 (defun* merge-component-name-type (name &key type defaults)
    1500   ;; For backwards compatibility only, for people using internals.
    1501   ;; Will be removed in a future release, e.g. 2.014.
    1502   (coerce-pathname name :type type :defaults defaults))
    1503 
    15041542(defun* coerce-pathname (name &key type defaults)
    15051543  "coerce NAME into a PATHNAME.
     
    15161554  ;; merge-pathnames with non-default hosts,  e.g. for logical-pathnames.
    15171555  ;; NOTE that the host and device slots will be taken from the defaults,
    1518   ;; but that should only matter if you either (a) use absolute pathnames, or
    1519   ;; (b) later merge relative pathnames with CL:MERGE-PATHNAMES instead of
    1520   ;; ASDF:MERGE-PATHNAMES*
     1556  ;; but that should only matter if you later merge relative pathnames with
     1557  ;; CL:MERGE-PATHNAMES instead of ASDF:MERGE-PATHNAMES*
    15211558  (etypecase name
    15221559    ((or null pathname)
     
    15361573             (t
    15371574              (split-name-type filename)))
    1538          (let* ((defaults (pathname (or defaults *default-pathname-defaults*)))
    1539                 (host (pathname-host defaults))
    1540                 (device (pathname-device defaults)))
    1541            (make-pathname :directory `(,relative ,@path)
    1542                           :name name :type type
    1543                           :host host :device device)))))))
     1575         (make-pathname :directory `(,relative ,@path) :name name :type type
     1576                        :defaults (or defaults *default-pathname-defaults*)))))))
     1577
     1578(defun* merge-component-name-type (name &key type defaults)
     1579  ;; For backwards compatibility only, for people using internals.
     1580  ;; Will be removed in a future release, e.g. 2.014.
     1581  (coerce-pathname name :type type :defaults defaults))
    15441582
    15451583(defmethod component-relative-pathname ((component component))
     
    17651803      (retry ()
    17661804        :report (lambda (s)
    1767       (errfmt s "Retry loading component ~S." required-c))
     1805      (format s "~@<Retry loading component ~3i~_~S.~@:>" required-c))
    17681806        :test
    17691807        (lambda (c)
     
    18091847                            (dep op (third d) nil)))
    18101848                         (t
    1811                           (error "Bad dependency ~a.  Dependencies must be (:version <version>), (:feature <feature> [version]), or a name" d))))))
     1849                          (error (compatfmt "~@<Bad dependency ~a.  Dependencies must be (:version <version>), (:feature <feature> [version]), or a name.~@:>") d))))))
    18121850           flag))))
    18131851
     
    19341972(defmethod perform ((operation operation) (c source-file))
    19351973  (sysdef-error
    1936    "required method PERFORM not implemented for operation ~A, component ~A"
     1974   (compatfmt "~@<Required method PERFORM not implemented for operation ~A, component ~A~@:>")
    19371975   (class-of operation) (class-of c)))
    19381976
     
    19451983
    19461984(defmethod operation-description (operation component)
    1947   (format nil "~A on component ~S" (class-of operation) (component-find-path component)))
     1985  (format nil (compatfmt "~@<~A on component ~S~@:>")
     1986    (class-of operation) (component-find-path component)))
    19481987
    19491988;;;; -------------------------------------------------------------------------
     
    19952034        (case (operation-on-warnings operation)
    19962035          (:warn (warn
    1997                   "COMPILE-FILE warned while performing ~A on ~A."
     2036                  (compatfmt "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>")
    19982037                  operation c))
    19992038          (:error (error 'compile-warned :component c :operation operation))
     
    20022041        (case (operation-on-failure operation)
    20032042          (:warn (warn
    2004                   "COMPILE-FILE failed while performing ~A on ~A."
     2043                  (compatfmt "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>")
    20052044                  operation c))
    20062045          (:error (error 'compile-failed :component c :operation operation))
     
    21042143(defmethod operation-description ((operation load-op) component)
    21052144  (declare (ignorable operation))
    2106   (format nil "loading component ~S" (component-find-path component)))
     2145  (format nil (compatfmt "~@<Loading component: ~3i~_~S~@:>")
     2146    (component-find-path component)))
    21072147
    21082148
     
    21472187(defmethod operation-description ((operation load-source-op) component)
    21482188  (declare (ignorable operation))
    2149   (format nil "loading component ~S" (component-find-path component)))
     2189  (format nil (compatfmt "~@<Loading component: ~3i~_~S~@:>")
     2190    (component-find-path component)))
    21502191
    21512192
     
    21982239                :report
    21992240                (lambda (s)
    2200       (errfmt s "Retry ~A." (operation-description op component))))
     2241      (format s (compatfmt "~@<Retry ~A.~@:>")
     2242        (operation-description op component))))
    22012243              (accept ()
    22022244                :report
    22032245                (lambda (s)
    2204       (errfmt s "Continue, treating ~A as having been successful."
     2246      (format s (compatfmt "~@<Continue, treating ~A as having been successful.~@:>")
    22052247        (operation-description op component)))
    22062248                (setf (gethash (type-of op)
     
    22882330
    22892331(defmacro defsystem (name &body options)
     2332  (setf name (coerce-name name))
    22902333  (destructuring-bind (&key (pathname nil pathname-arg-p) (class 'system)
    22912334                            defsystem-depends-on &allow-other-keys)
     
    22972340         ;; to reuse options (e.g. pathname) from
    22982341         ,@(loop :for system :in defsystem-depends-on
    2299              :collect `(load-system ,system))
     2342             :collect `(load-system ',(coerce-name system)))
    23002343         (let ((s (system-registered-p ',name)))
    23012344           (cond ((and s (eq (type-of (cdr s)) ',class))
     
    23582401(defun* sysdef-error-component (msg type name value)
    23592402  (sysdef-error (concatenate 'string msg
    2360                              "~&The value specified for ~(~A~) ~A is ~S")
     2403                             (compatfmt "~&~@<The value specified for ~(~A~) ~A is ~S~@:>"))
    23612404                type name value))
    23622405
     
    26892732                  "unknown"))))
    26902733    (let ((lisp (maybe-warn (implementation-type)
    2691                             "No implementation feature found in ~a."
     2734                            (compatfmt "~@<No implementation feature found in ~a.~@:>")
    26922735                            *implementation-features*))
    26932736          (os   (maybe-warn (first-feature *os-features*)
    2694                             "No os feature found in ~a." *os-features*))
     2737                            (compatfmt "~@<No OS feature found in ~a.~@:>") *os-features*))
    26952738          (arch (or #-clisp
    26962739                    (maybe-warn (first-feature *architecture-features*)
    2697                                 "No architecture feature found in ~a."
     2740                                (compatfmt "~@<No architecture feature found in ~a.~@:>")
    26982741                                *architecture-features*)))
    26992742          (version (maybe-warn (lisp-version-string)
     
    27952838    (unless (= inherit 1)
    27962839      (report-invalid-form invalid-form-reporter
    2797              :arguments (list "One and only one of ~S or ~S is required"
     2840             :arguments (list (compatfmt "~@<One and only one of ~S or ~S is required.~@:>")
    27982841                              :inherit-configuration :ignore-inherited-configuration)))
    27992842    (return (nreverse x))))
     
    28022845  (let ((forms (read-file-forms file)))
    28032846    (unless (length=n-p forms 1)
    2804       (error "One and only one form allowed for ~A. Got: ~S~%" description forms))
     2847      (error (compatfmt "~@<One and only one form allowed for ~A. Got: ~3i~_~S~@:>~%")
     2848       description forms))
    28052849    (funcall validator (car forms) :location file)))
    28062850
     
    29232967         (s (if (or (pathnamep x) (not wilden)) d (wilden d))))
    29242968    (when (and (absolute-pathname-p s) (not (pathname-match-p s (wilden super))))
    2925       (error "pathname ~S is not relative to ~S" s super))
     2969      (error (compatfmt "~@<Pathname ~S is not relative to ~S~@:>") s super))
    29262970    (merge-pathnames* s super)))
    29272971
     
    29653009                r)))
    29663010    (unless (absolute-pathname-p s)
    2967       (error "Not an absolute pathname ~S" s))
     3011      (error (compatfmt "~@<Not an absolute pathname: ~3i~_~S~@:>") s))
    29683012    s))
    29693013
     
    30373081     '(:output-translations :inherit-configuration))
    30383082    ((not (stringp string))
    3039      (error "environment string isn't: ~S" string))
     3083     (error (compatfmt "~@<Environment string isn't: ~3i~_~S~@:>") string))
    30403084    ((eql (char string 0) #\")
    30413085     (parse-output-translations-string (read-from-string string) :location location))
     
    30573101          ((equal "" s)
    30583102           (when inherit
    3059              (error "only one inherited configuration allowed: ~S" string))
     3103             (error (compatfmt "~@<Only one inherited configuration allowed: ~3i~_~S~@:>")
     3104        string))
    30603105           (setf inherit t)
    30613106           (push :inherit-configuration directives))
     
    30653110        (when (> start end)
    30663111          (when source
    3067             (error "Uneven number of components in source to destination mapping ~S" string))
     3112            (error (compatfmt "~@<Uneven number of components in source to destination mapping: ~3i~_~S~@:>")
     3113       string))
    30683114          (unless inherit
    30693115            (push :ignore-inherited-configuration directives))
     
    32163262     path)
    32173263    ((not (pathnamep destination))
    3218      (error "invalid destination"))
     3264     (error "Invalid destination"))
    32193265    ((not (absolute-pathname-p destination))
    32203266     (translate-pathname path absolute-source (merge-pathnames* destination root)))
     
    35473593     '(:source-registry :inherit-configuration))
    35483594    ((not (stringp string))
    3549      (error "environment string isn't: ~S" string))
     3595     (error (compatfmt "~@<Environment string isn't: ~3i~_~S~@:>") string))
    35503596    ((find (char string 0) "\"(")
    35513597     (validate-source-registry-form (read-from-string string) :location location))
     
    35613607         ((equal "" s) ; empty element: inherit
    35623608          (when inherit
    3563             (error "only one inherited configuration allowed: ~S" string))
     3609            (error (compatfmt "~@<Only one inherited configuration allowed: ~3i~_~S~@:>")
     3610       string))
    35643611          (setf inherit t)
    35653612          (push ':inherit-configuration directives))
     
    37573804       (missing-component (constantly nil))
    37583805       (error #'(lambda (e)
    3759                   (errfmt *error-output* "ASDF could not load ~(~A~) because ~A.~%"
     3806                  (format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%")
    37603807                          name e))))
    3761     (let* ((*verbose-out* (make-broadcast-stream))
     3808    (let ((*verbose-out* (make-broadcast-stream))
    37623809           (system (find-system (string-downcase name) nil)))
    37633810      (when system
    3764         (load-system system)
    3765         t))))
     3811        (load-system system)))))
    37663812
    37673813#+(or abcl clisp clozure cmu ecl sbcl)
Note: See TracChangeset for help on using the changeset viewer.