Changeset 14470


Ignore:
Timestamp:
Dec 7, 2010, 10:17:22 AM (14 years ago)
Author:
R. Matthew Emerson
Message:

ASDF 2.011 from upstream.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/tools/asdf.lisp

    r14380 r14470  
    5050(cl:in-package :cl-user)
    5151
     52#+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this
     53
    5254(eval-when (:compile-toplevel :load-toplevel :execute)
    5355  ;;; make package if it doesn't exist yet.
    … …  
    6769;;;; Create packages in a way that is compatible with hot-upgrade.
    6870;;;; See https://bugs.launchpad.net/asdf/+bug/485687
    69 ;;;; See more at the end of the file.
     71;;;; See more near the end of the file.
    7072
    7173(eval-when (:load-toplevel :compile-toplevel :execute)
    7274  (defvar *asdf-version* nil)
    7375  (defvar *upgraded-p* nil)
    74   (let* ((asdf-version "2.010") ;; same as 2.146
     76  (let* (;; For bug reporting sanity, please always bump this version when you modify this file.
     77         ;; "2.345" would be an official release
     78         ;; "2.345.6" would be a development version in the official upstream
     79         ;; "2.345.0.7" would be your local modification of an official release
     80         ;; "2.345.6.7" would be your local modification of a development version
     81         (asdf-version "2.011")
    7582         (existing-asdf (fboundp 'find-system))
    7683         (existing-version *asdf-version*)
    … …  
    7885    (unless (and existing-asdf already-there)
    7986      (when existing-asdf
    80         (format *error-output*
    81                 "~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%"
    82                 existing-version asdf-version))
     87        (format *trace-output*
     88         "~&~@<; ~@;Upgrading ASDF package ~@[from version ~A ~]to version ~A~@:>~%"
     89         existing-version asdf-version))
    8390      (labels
    8491          ((unlink-package (package)
    … …  
    181188           :unintern
    182189           (#:*asdf-revision* #:around #:asdf-method-combination
    183             #:split #:make-collector)
     190            #:split #:make-collector
     191            #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function
    184192           :fmakunbound
    185193           (#:system-source-file
    … …  
    235243            #:map-systems
    236244
     245            #:operation-description
    237246            #:operation-on-warnings
    238247            #:operation-on-failure
    … …  
    287296            ;; Utilities
    288297            #:absolute-pathname-p
    289             ;; #:aif #:it
     298            ;; #:aif #:it
    290299            ;; #:appendf
    291300            #:coerce-name
    … …  
    296305            ;; #:get-uid
    297306            ;; #:length=n-p
     307            ;; #:find-symbol*
    298308            #:merge-pathnames*
    299309            #:pathname-directory-pathname
    300310            #:read-file-forms
    301             ;; #:remove-keys
    302             ;; #:remove-keyword
     311            ;; #:remove-keys
     312            ;; #:remove-keyword
    303313            #:resolve-symlinks
    304314            #:split-string
    … …  
    313323                               *upgraded-p*))))))
    314324
    315 ;; More cleanups in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
    316 (when *upgraded-p*
    317    #+ecl
    318    (when (find-class 'compile-op nil)
    319      (defmethod update-instance-for-redefined-class :after
    320          ((c compile-op) added deleted plist &key)
    321        (declare (ignore added deleted))
    322        (let ((system-p (getf plist 'system-p)))
    323          (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))
    324    (when (find-class 'module nil)
    325      (eval
    326       '(progn
    327          (defmethod update-instance-for-redefined-class :after
    328              ((m module) added deleted plist &key)
    329            (declare (ignorable deleted plist))
    330            (when *asdf-verbose* (format *trace-output* "Updating ~A~%" m))
    331            (when (member 'components-by-name added)
    332              (compute-module-components-by-name m)))
    333          (defmethod update-instance-for-redefined-class :after
    334              ((s system) added deleted plist &key)
    335            (declare (ignorable deleted plist))
    336            (when *asdf-verbose* (format *trace-output* "Updating ~A~%" s))
    337            (when (member 'source-file added)
    338              (%set-system-source-file (probe-asd (component-name s) (component-pathname s)) s)))))))
    339 
    340325;;;; -------------------------------------------------------------------------
    341326;;;; User-visible parameters
    … …  
    379364
    380365;;;; -------------------------------------------------------------------------
    381 ;;;; ASDF Interface, in terms of generic functions.
     366;;;; General Purpose Utilities
     367
    382368(macrolet
    383369    ((defdef (def* def)
    … …  
    390376  (defdef defgeneric* defgeneric)
    391377  (defdef defun* defun))
    392 
    393 (defgeneric* find-system (system &optional error-p))
    394 (defgeneric* perform-with-restarts (operation component))
    395 (defgeneric* perform (operation component))
    396 (defgeneric* operation-done-p (operation component))
    397 (defgeneric* explain (operation component))
    398 (defgeneric* output-files (operation component))
    399 (defgeneric* input-files (operation component))
    400 (defgeneric* component-operation-time (operation component))
    401 (defgeneric* operation-description (operation component)
    402   (:documentation "returns a phrase that describes performing this operation
    403 on this component, e.g. \"loading /a/b/c\".
    404 You can put together sentences using this phrase."))
    405 
    406 (defgeneric* system-source-file (system)
    407   (:documentation "Return the source file in which system is defined."))
    408 
    409 (defgeneric* component-system (component)
    410   (:documentation "Find the top-level system containing COMPONENT"))
    411 
    412 (defgeneric* component-pathname (component)
    413   (:documentation "Extracts the pathname applicable for a particular component."))
    414 
    415 (defgeneric* component-relative-pathname (component)
    416   (:documentation "Returns a pathname for the component argument intended to be
    417 interpreted relative to the pathname of that component's parent.
    418 Despite the function's name, the return value may be an absolute
    419 pathname, because an absolute pathname may be interpreted relative to
    420 another pathname in a degenerate way."))
    421 
    422 (defgeneric* component-property (component property))
    423 
    424 (defgeneric* (setf component-property) (new-value component property))
    425 
    426 (defgeneric* version-satisfies (component version))
    427 
    428 (defgeneric* find-component (base path)
    429   (:documentation "Finds the component with PATH starting from BASE module;
    430 if BASE is nil, then the component is assumed to be a system."))
    431 
    432 (defgeneric* source-file-type (component system))
    433 
    434 (defgeneric* operation-ancestor (operation)
    435   (:documentation
    436    "Recursively chase the operation's parent pointer until we get to
    437 the head of the tree"))
    438 
    439 (defgeneric* component-visited-p (operation component)
    440   (:documentation "Returns the value stored by a call to
    441 VISIT-COMPONENT, if that has been called, otherwise NIL.
    442 This value stored will be a cons cell, the first element
    443 of which is a computed key, so not interesting.  The
    444 CDR wil be the DATA value stored by VISIT-COMPONENT; recover
    445 it as (cdr (component-visited-p op c)).
    446   In the current form of ASDF, the DATA value retrieved is
    447 effectively a boolean, indicating whether some operations are
    448 to be performed in order to do OPERATION X COMPONENT.  If the
    449 data value is NIL, the combination had been explored, but no
    450 operations needed to be performed."))
    451 
    452 (defgeneric* visit-component (operation component data)
    453   (:documentation "Record DATA as being associated with OPERATION
    454 and COMPONENT.  This is a side-effecting function:  the association
    455 will be recorded on the ROOT OPERATION \(OPERATION-ANCESTOR of the
    456 OPERATION\).
    457   No evidence that DATA is ever interesting, beyond just being
    458 non-NIL.  Using the data field is probably very risky; if there is
    459 already a record for OPERATION X COMPONENT, DATA will be quietly
    460 discarded instead of recorded.
    461   Starting with 2.006, TRAVERSE will store an integer in data,
    462 so that nodes can be sorted in decreasing order of traversal."))
    463 
    464 
    465 (defgeneric* (setf visiting-component) (new-value operation component))
    466 
    467 (defgeneric* component-visiting-p (operation component))
    468 
    469 (defgeneric* component-depends-on (operation component)
    470   (:documentation
    471    "Returns a list of dependencies needed by the component to perform
    472     the operation.  A dependency has one of the following forms:
    473 
    474       (<operation> <component>*), where <operation> is a class
    475         designator and each <component> is a component
    476         designator, which means that the component depends on
    477         <operation> having been performed on each <component>; or
    478 
    479       (FEATURE <feature>), which means that the component depends
    480         on <feature>'s presence in *FEATURES*.
    481 
    482     Methods specialized on subclasses of existing component types
    483     should usually append the results of CALL-NEXT-METHOD to the
    484     list."))
    485 
    486 (defgeneric* component-self-dependencies (operation component))
    487 
    488 (defgeneric* traverse (operation component)
    489   (:documentation
    490 "Generate and return a plan for performing OPERATION on COMPONENT.
    491 
    492 The plan returned is a list of dotted-pairs. Each pair is the CONS
    493 of ASDF operation object and a COMPONENT object. The pairs will be
    494 processed in order by OPERATE."))
    495 
    496 
    497 ;;;; -------------------------------------------------------------------------
    498 ;;;; General Purpose Utilities
    499378
    500379(defmacro while-collecting ((&rest collectors) &body body)
    … …  
    536415         (directory
    537416          (cond
    538             #-(or sbcl cmu)
     417            #-(or sbcl cmu scl)
    539418            ((stringp directory) `(:absolute ,directory) directory)
    540419            #+gcl
    541             ((and (consp directory) (stringp (first directory)))
    542              `(:absolute ,@directory))
     420            ((and (consp directory) (not (member (first directory) '(:absolute :relative))))
     421             `(:relative ,@directory))
    543422            ((or (null directory)
    544423                 (and (consp directory) (member (first directory) '(:absolute :relative))))
    … …  
    676555
    677556(defun* getenv (x)
    678   (#+abcl ext:getenv
     557  (#+(or abcl clisp) ext:getenv
    679558   #+allegro sys:getenv
    680    #+clisp ext:getenv
    681559   #+clozure ccl:getenv
    682560   #+(or cmu scl) (lambda (x) (cdr (assoc x ext:*environment-list* :test #'string=)))
    … …  
    724602
    725603(defun* absolute-pathname-p (pathspec)
    726   (and pathspec (eq :absolute (car (pathname-directory (pathname pathspec))))))
     604  (and (typep pathspec '(or pathname string))
     605       (eq :absolute (car (pathname-directory (pathname pathspec))))))
    727606
    728607(defun* length=n-p (x n) ;is it that (= (length x) n) ?
    … …  
    756635    #+allegro (excl.osi:getuid)
    757636    #+clisp (loop :for s :in '("posix:uid" "LINUX:getuid")
    758                   :for f = (ignore-errors (read-from-string s))
     637                  :for f = (ignore-errors (read-from-string s))
    759638                  :when f :return (funcall f))
    760639    #+(or cmu scl) (unix:unix-getuid)
    … …  
    778657                 :name nil :type nil :version nil))
    779658
     659(defun* find-symbol* (s p)
     660  (find-symbol (string s) p))
     661
    780662(defun* probe-file* (p)
    781663  "when given a pathname P, probes the filesystem for a file or directory
    … …  
    786668   (pathname (unless (wild-pathname-p p)
    787669               #.(or #+(or allegro clozure cmu ecl sbcl scl) '(probe-file p)
    788                #+clisp (aif (find-symbol (string :probe-pathname) :ext) `(ignore-errors (,it p)))
    789                '(ignore-errors (truename p)))))))
     670               #+clisp (aif (find-symbol (string '#:probe-pathname) :ext) `(ignore-errors (,it p)))
     671               '(ignore-errors (truename p)))))))
    790672
    791673(defun* truenamize (p)
    … …  
    858740                            :directory `(:absolute ,@path))))
    859741        (translate-pathname absolute-pathname wild-root (wilden new-base))))))
     742
     743;;;; -------------------------------------------------------------------------
     744;;;; ASDF Interface, in terms of generic functions.
     745(defgeneric* find-system (system &optional error-p))
     746(defgeneric* perform-with-restarts (operation component))
     747(defgeneric* perform (operation component))
     748(defgeneric* operation-done-p (operation component))
     749(defgeneric* explain (operation component))
     750(defgeneric* output-files (operation component))
     751(defgeneric* input-files (operation component))
     752(defgeneric* component-operation-time (operation component))
     753(defgeneric* operation-description (operation component)
     754  (:documentation "returns a phrase that describes performing this operation
     755on this component, e.g. \"loading /a/b/c\".
     756You can put together sentences using this phrase."))
     757
     758(defgeneric* system-source-file (system)
     759  (:documentation "Return the source file in which system is defined."))
     760
     761(defgeneric* component-system (component)
     762  (:documentation "Find the top-level system containing COMPONENT"))
     763
     764(defgeneric* component-pathname (component)
     765  (:documentation "Extracts the pathname applicable for a particular component."))
     766
     767(defgeneric* component-relative-pathname (component)
     768  (:documentation "Returns a pathname for the component argument intended to be
     769interpreted relative to the pathname of that component's parent.
     770Despite the function's name, the return value may be an absolute
     771pathname, because an absolute pathname may be interpreted relative to
     772another pathname in a degenerate way."))
     773
     774(defgeneric* component-property (component property))
     775
     776(defgeneric* (setf component-property) (new-value component property))
     777
     778(defgeneric* version-satisfies (component version))
     779
     780(defgeneric* find-component (base path)
     781  (:documentation "Finds the component with PATH starting from BASE module;
     782if BASE is nil, then the component is assumed to be a system."))
     783
     784(defgeneric* source-file-type (component system))
     785
     786(defgeneric* operation-ancestor (operation)
     787  (:documentation
     788   "Recursively chase the operation's parent pointer until we get to
     789the head of the tree"))
     790
     791(defgeneric* component-visited-p (operation component)
     792  (:documentation "Returns the value stored by a call to
     793VISIT-COMPONENT, if that has been called, otherwise NIL.
     794This value stored will be a cons cell, the first element
     795of which is a computed key, so not interesting.  The
     796CDR wil be the DATA value stored by VISIT-COMPONENT; recover
     797it as (cdr (component-visited-p op c)).
     798  In the current form of ASDF, the DATA value retrieved is
     799effectively a boolean, indicating whether some operations are
     800to be performed in order to do OPERATION X COMPONENT.  If the
     801data value is NIL, the combination had been explored, but no
     802operations needed to be performed."))
     803
     804(defgeneric* visit-component (operation component data)
     805  (:documentation "Record DATA as being associated with OPERATION
     806and COMPONENT.  This is a side-effecting function:  the association
     807will be recorded on the ROOT OPERATION \(OPERATION-ANCESTOR of the
     808OPERATION\).
     809  No evidence that DATA is ever interesting, beyond just being
     810non-NIL.  Using the data field is probably very risky; if there is
     811already a record for OPERATION X COMPONENT, DATA will be quietly
     812discarded instead of recorded.
     813  Starting with 2.006, TRAVERSE will store an integer in data,
     814so that nodes can be sorted in decreasing order of traversal."))
     815
     816
     817(defgeneric* (setf visiting-component) (new-value operation component))
     818
     819(defgeneric* component-visiting-p (operation component))
     820
     821(defgeneric* component-depends-on (operation component)
     822  (:documentation
     823   "Returns a list of dependencies needed by the component to perform
     824    the operation.  A dependency has one of the following forms:
     825
     826      (<operation> <component>*), where <operation> is a class
     827        designator and each <component> is a component
     828        designator, which means that the component depends on
     829        <operation> having been performed on each <component>; or
     830
     831      (FEATURE <feature>), which means that the component depends
     832        on <feature>'s presence in *FEATURES*.
     833
     834    Methods specialized on subclasses of existing component types
     835    should usually append the results of CALL-NEXT-METHOD to the
     836    list."))
     837
     838(defgeneric* component-self-dependencies (operation component))
     839
     840(defgeneric* traverse (operation component)
     841  (:documentation
     842"Generate and return a plan for performing OPERATION on COMPONENT.
     843
     844The plan returned is a list of dotted-pairs. Each pair is the CONS
     845of ASDF operation object and a COMPONENT object. The pairs will be
     846processed in order by OPERATE."))
     847
     848
     849;;;; -------------------------------------------------------------------------
     850;;; Methods in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
     851(when *upgraded-p*
     852   #+ecl
     853   (when (find-class 'compile-op nil)
     854     (defmethod update-instance-for-redefined-class :after
     855         ((c compile-op) added deleted plist &key)
     856       (declare (ignore added deleted))
     857       (let ((system-p (getf plist 'system-p)))
     858         (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))
     859   (when (find-class 'module nil)
     860     (eval
     861      `(defmethod update-instance-for-redefined-class :after
     862           ((m module) added deleted plist &key)
     863         (declare (ignorable deleted plist))
     864         (when (or *asdf-verbose* *load-verbose*)
     865           (asdf-message "~&~@<; ~@; Updating ~A for ASDF ~A~@:>~%" m ,(asdf-version)))
     866         (when (member 'components-by-name added)
     867           (compute-module-components-by-name m))
     868         (when (and (typep m 'system) (member 'source-file added))
     869           (%set-system-source-file (probe-asd (component-name m) (component-pathname m)) m))))))
    860870
    861871;;;; -------------------------------------------------------------------------
    … …  
    10011011          (missing-requires c)
    10021012          (when (missing-parent c)
    1003             (component-name (missing-parent c)))))
     1013            (coerce-name (missing-parent c)))))
    10041014
    10051015(defmethod print-object ((c missing-component-of-version) s)
    … …  
    12961306                 (let ((*package* package))
    12971307                   (asdf-message
    1298                     "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
     1308                    "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%"
    12991309                    on-disk *package*)
    13001310                   (load on-disk)))
    … …  
    13101320
    13111321(defun* register-system (name system)
    1312   (asdf-message "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
     1322  (asdf-message "~&~@<; ~@;Registering ~A as ~A~@:>~%" system name)
    13131323  (setf (gethash (coerce-name name) *defined-systems*)
    13141324        (cons (get-universal-time) system)))
    … …  
    13161326(defun* find-system-fallback (requested fallback &rest keys &key source-file &allow-other-keys)
    13171327  (setf fallback (coerce-name fallback)
    1318         source-file (or source-file *compile-file-truename* *load-truename*)
     1328        source-file (or source-file
     1329                        (if *resolve-symlinks*
     1330                            (or *compile-file-truename* *load-truename*)
     1331                            (or *compile-file-pathname* *load-pathname*)))
    13191332        requested (coerce-name requested))
    13201333  (when (equal requested fallback)
    … …  
    13221335           (system (or registered
    13231336                       (apply 'make-instance 'system
    1324                               :name fallback :source-file source-file keys))))
     1337                              :name fallback :source-file source-file keys))))
    13251338      (unless registered
    13261339        (register-system fallback system))
    … …  
    22022215(defun* class-for-type (parent type)
    22032216  (or (loop :for symbol :in (list
    2204                              (unless (keywordp type) type)
    2205                              (find-symbol (symbol-name type) *package*)
    2206                              (find-symbol (symbol-name type) :asdf))
     2217                             type
     2218                             (find-symbol* type *package*)
     2219                             (find-symbol* type :asdf))
    22072220        :for class = (and symbol (find-class symbol nil))
    22082221        :when (and class (subtypep class 'component))
    … …  
    23912404         :input nil :whole nil
    23922405         #+mswindows :show-window #+mswindows :hide)
    2393       (format *verbose-out* "~{~&; ~a~%~}~%" stderr)
    2394       (format *verbose-out* "~{~&; ~a~%~}~%" stdout)
     2406      (asdf-message "~{~&; ~a~%~}~%" stderr)
     2407      (asdf-message "~{~&; ~a~%~}~%" stdout)
    23952408      exit-code)
    23962409
    … …  
    31213134;;;; -----------------------------------------------------------------
    31223135;;;; Compatibility mode for ASDF-Binary-Locations
     3136
     3137(defmethod operate :before (operation-class system &rest args &key &allow-other-keys)
     3138  (declare (ignorable operation-class system args))
     3139  (when (find-symbol* '#:output-files-for-system-and-operation :asdf)
     3140    (error "ASDF 2 is not compatible with ASDF-BINARY-LOCATIONS, which you are using.
     3141ASDF 2 now achieves the same purpose with its builtin ASDF-OUTPUT-TRANSLATIONS,
     3142which should be easier to configure. Please stop using ASDF-BINARY-LOCATIONS,
     3143and instead use ASDF-OUTPUT-TRANSLATIONS. See the ASDF manual for details.
     3144In case you insist on preserving your previous A-B-L configuration, but
     3145do not know how to achieve the same effect with A-O-T, you may use function
     3146ASDF:ENABLE-ASDF-BINARY-LOCATIONS-COMPATIBILITY as documented in the manual;
     3147call that function where you would otherwise have loaded and configured A-B-L.")))
    31233148
    31243149(defun* enable-asdf-binary-locations-compatibility
    … …  
    35493574
    35503575;;;; -----------------------------------------------------------------
    3551 ;;;; Hook into REQUIRE for ABCL, ClozureCL, CMUCL, ECL and SBCL
     3576;;;; Hook into REQUIRE for ABCL, CLISP, ClozureCL, CMUCL, ECL and SBCL
    35523577;;;;
    35533578(defun* module-provide-asdf (name)
    … …  
    35653590
    35663591#+(or abcl clisp clozure cmu ecl sbcl)
    3567 (let ((x (and #+clisp (find-symbol "*MODULE-PROVIDER-FUNCTIONS*" :custom))))
     3592(let ((x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom))))
    35683593  (when x
    35693594    (eval `(pushnew 'module-provide-asdf
Note: See TracChangeset for help on using the changeset viewer.