Changeset 16780


Ignore:
Timestamp:
Jul 21, 2016, 4:21:19 PM (5 years ago)
Author:
rme
Message:

Update to ASDF 3.1.7.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/tools/asdf.lisp

    r16637 r16780  
    1 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
    2 ;;; This is ASDF 3.1.6: Another System Definition Facility.
     1;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
     2;;; This is ASDF 3.1.7: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    4747
    4848#+xcvb (module ())
    49 
    50 (in-package :cl-user)
    51 
    52 #+cmu
    53 (eval-when (:load-toplevel :compile-toplevel :execute)
    54   (setf ext:*gc-verbose* nil))
    55 
    56 ;;; pre 1.3.0 ABCL versions do not support the bundle-op on Mac OS X
    57 #+abcl
    58 (eval-when (:load-toplevel :compile-toplevel :execute)
    59   (unless (and (member :darwin *features*)
    60                (second (third (sys::arglist 'directory))))
    61     (push :abcl-bundle-op-supported *features*)))
    62 
    63 ;; Punt on hard package upgrade: from ASDF1 always, and even from ASDF2 on most implementations.
    64 (eval-when (:load-toplevel :compile-toplevel :execute)
    65   (unless (member :asdf3 *features*)
    66     (let* ((existing-version
    67              (when (find-package :asdf)
    68                (or (symbol-value (find-symbol (string :*asdf-version*) :asdf))
    69                    (let ((ver (symbol-value (find-symbol (string :*asdf-revision*) :asdf))))
    70                      (etypecase ver
    71                        (string ver)
    72                        (cons (format nil "~{~D~^.~}" ver))
    73                        (null "1.0"))))))
    74            (first-dot (when existing-version (position #\. existing-version)))
    75            (second-dot (when first-dot (position #\. existing-version :start (1+ first-dot))))
    76            (existing-major-minor (subseq existing-version 0 second-dot))
    77            (existing-version-number (and existing-version (read-from-string existing-major-minor)))
    78            (away (format nil "~A-~A" :asdf existing-version)))
    79       (when (and existing-version
    80                  (< existing-version-number
    81                     #+(or allegro clisp lispworks sbcl) 2.0
    82                     #-(or allegro clisp lispworks sbcl) 2.27))
    83         (rename-package :asdf away)
    84         (when *load-verbose*
    85           (format t "~&; Renamed old ~A package away to ~A~%" :asdf away))))))
    8649;;;; ---------------------------------------------------------------------------
    8750;;;; Handle ASDF package upgrade, including implementation-dependent magic.
     
    823786       (eval-when (:compile-toplevel :load-toplevel :execute)
    824787         ,ensure-form))))
    825 
    826 ;;;; Final tricks to keep various implementations happy.
    827 ;; We want most such tricks in common-lisp.lisp,
    828 ;; but these need to be done before the define-package form there,
    829 ;; that we nevertheless want to be the very first form.
    830 (eval-when (:load-toplevel :compile-toplevel :execute)
    831   #+allegro ;; We need to disable autoloading BEFORE any mention of package ASDF.
    832   (setf excl::*autoload-package-name-alist*
    833         (remove "asdf" excl::*autoload-package-name-alist*
    834                 :test 'equalp :key 'car)))
    835 
    836 ;; Compatibility with whoever calls asdf/package
    837 (define-package :asdf/package (:use :cl :uiop/package) (:reexport :uiop/package))
    838788;;;; -------------------------------------------------------------------------
    839789;;;; Handle compatibility with multiple implementations.
     
    845795
    846796(uiop/package:define-package :uiop/common-lisp
    847   (:nicknames :uoip/cl :asdf/common-lisp :asdf/cl)
     797  (:nicknames :uoip/cl)
    848798  (:use :uiop/package)
    849799  (:use-reexport #-genera :common-lisp #+genera :future-common-lisp)
    850   (:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf)
    851800  #+allegro (:intern #:*acl-warn-save*)
    852801  #+cormanlisp (:shadow #:user-homedir-pathname)
     
    857806  #+genera (:shadowing-import-from :scl #:boolean)
    858807  #+genera (:export #:boolean #:ensure-directories-exist #:read-sequence #:write-sequence)
    859   #+mcl (:shadow #:user-homedir-pathname))
     808  #+(or mcl cmucl) (:shadow #:user-homedir-pathname))
    860809(in-package :uiop/common-lisp)
    861810
    862 #-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
     811#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
    863812(error "ASDF is not supported on your implementation. Please help us port it.")
    864813
     
    868817;;;; Early meta-level tweaks
    869818
    870 #+(or abcl allegro clasp clisp cmu ecl mkcl clozure lispworks mkcl sbcl scl)
     819#+(or allegro clasp clisp cmucl ecl mkcl mkcl sbcl)
    871820(eval-when (:load-toplevel :compile-toplevel :execute)
    872   ;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode
    873   ;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie.
    874821  (when (and #+allegro (member :ics *features*)
    875              #+(or clasp clisp cmu ecl mkcl) (member :unicode *features*)
     822             #+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*)
    876823             #+sbcl (member :sb-unicode *features*))
     824    ;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode
     825    ;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie.
    877826    (pushnew :asdf-unicode *features*)))
    878827
    879828#+allegro
    880829(eval-when (:load-toplevel :compile-toplevel :execute)
     830  ;; We need to disable autoloading BEFORE any mention of package ASDF.
     831  ;; In particular, there must NOT be a mention of package ASDF in the defpackage of this file
     832  ;; or any previous file.
     833  (setf excl::*autoload-package-name-alist*
     834        (remove "asdf" excl::*autoload-package-name-alist*
     835                :test 'equalp :key 'car))
    881836  (defparameter *acl-warn-save*
    882837    (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
     
    902857       (values (external-process-%exit-code proc)
    903858               (external-process-%status proc))))))
    904 #+clozure (in-package :uiop/common-lisp)
     859#+clozure (in-package :uiop/common-lisp) ;; back in this package.
     860
     861#+cmucl
     862(eval-when (:load-toplevel :compile-toplevel :execute)
     863  (setf ext:*gc-verbose* nil)
     864  (defun user-homedir-pathname ()
     865    (first (ext:search-list (cl:user-homedir-pathname)))))
    905866
    906867#+cormanlisp
     
    1036997
    1037998(uiop/package:define-package :uiop/utility
    1038   (:nicknames :asdf/utility)
    1039   (:recycle :uiop/utility :asdf/utility :asdf)
    1040999  (:use :uiop/common-lisp :uiop/package)
    10411000  ;; import and reexport a few things defined in :uiop/common-lisp
     
    16191578    #+clisp 'system::$format-control
    16201579    #+clozure 'ccl::format-control
    1621     #+(or cmu scl) 'conditions::format-control
     1580    #+(or cmucl scl) 'conditions::format-control
    16221581    #+(or clasp ecl mkcl) 'si::format-control
    16231582    #+(or gcl lispworks) 'conditions::format-string
    16241583    #+sbcl 'sb-kernel:format-control
    1625     #-(or abcl allegro clasp clisp clozure cmu ecl gcl lispworks mkcl sbcl scl) nil
     1584    #-(or abcl allegro clasp clisp clozure cmucl ecl gcl lispworks mkcl sbcl scl) nil
    16261585    "Name of the slot for FORMAT-CONTROL in simple-condition")
    16271586
     
    16381597      (string (and (typep condition 'simple-condition)
    16391598                   ;; On SBCL, it's always set and the check triggers a warning
    1640                    #+(or allegro clozure cmu lispworks scl)
     1599                   #+(or allegro clozure cmucl lispworks scl)
    16411600                   (slot-boundp condition +simple-condition-format-control-slot+)
    16421601                   (ignore-errors (equal (simple-condition-format-control condition) x))))))
     
    16601619
    16611620(uiop/package:define-package :uiop/os
    1662   (:nicknames :asdf/os)
    1663   (:recycle :uiop/os :asdf/os :asdf)
    16641621  (:use :uiop/common-lisp :uiop/package :uiop/utility)
    16651622  (:export
     
    17451702    #+allegro (sys:getenv x)
    17461703    #+clozure (ccl:getenv x)
    1747     #+cmu (unix:unix-getenv x)
     1704    #+cmucl (unix:unix-getenv x)
    17481705    #+scl (cdr (assoc x ext:*environment-list* :test #'string=))
    17491706    #+cormanlisp
     
    17661723    #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)
    17671724    #+sbcl (sb-ext:posix-getenv x)
    1768     #-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
     1725    #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
    17691726    (error "~S is not supported on your implementation" 'getenv))
    17701727
     
    17751732    #+clisp `(system::setenv ,x ,val)
    17761733    #+clozure `(ccl:setenv ,x ,val)
    1777     #+cmu `(unix:unix-setenv ,x ,val 1)
     1734    #+cmucl `(unix:unix-setenv ,x ,val 1)
    17781735    #+ecl `(ext:setenv ,x ,val)
    17791736    #+lispworks `(hcl:setenv ,x ,val)
    17801737    #+mkcl `(mkcl:setenv ,x ,val)
    17811738    #+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1))
    1782     #-(or allegro clisp clozure cmu ecl lispworks mkcl sbcl)
     1739    #-(or allegro clisp clozure cmucl ecl lispworks mkcl sbcl)
    17831740    '(error "~S ~S is not supported on your implementation" 'setf 'getenv))
    17841741
     
    18721829                ccl::*openmcl-minor-version*
    18731830                (logand (ccl-fasl-version) #xFF))
    1874         #+cmu (substitute #\- #\/ s)
     1831        #+cmucl (substitute #\- #\/ s)
    18751832        #+scl (format nil "~A~A" s
    18761833                      ;; ANSI upper case vs lower case.
     
    19061863    "return the hostname of the current host"
    19071864    ;; Note: untested on RMCL
    1908     #+(or abcl clasp clozure cmu ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance)
     1865    #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance)
    19091866    #+cormanlisp "localhost" ;; is there a better way? Does it matter?
    19101867    #+allegro (symbol-call :excl.osi :gethostname)
     
    19161873(with-upgradability ()
    19171874
    1918   #+cmu
     1875  #+cmucl
    19191876  (defun parse-unix-namestring* (unix-namestring)
    19201877    "variant of LISP::PARSE-UNIX-NAMESTRING that returns a pathname object"
     
    19301887        #+clisp (ext:default-directory)
    19311888        #+clozure (ccl:current-directory)
    1932         #+(or cmu scl) (#+cmu parse-unix-namestring* #+scl lisp::parse-unix-namestring
     1889        #+(or cmucl scl) (#+cmucl parse-unix-namestring* #+scl lisp::parse-unix-namestring
    19331890                        (strcat (nth-value 1 (unix:unix-current-directory)) "/"))
    19341891        #+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
     
    19481905      #+clisp (ext:cd x)
    19491906      #+clozure (setf (ccl:current-directory) x)
    1950       #+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x))
     1907      #+(or cmucl scl) (unix:unix-chdir (ext:unix-namestring x))
    19511908      #+cormanlisp (unless (zerop (win32::_chdir (namestring x)))
    19521909                     (error "Could not set current directory to ~A" x))
     
    19561913      #+mkcl (mk-ext:chdir x)
    19571914      #+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :chdir (sb-ext:native-namestring x)))
    1958       #-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mkcl sbcl scl xcl)
     1915      #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mkcl sbcl scl xcl)
    19591916      (error "chdir not supported on your implementation"))))
    19601917
     
    20492006
    20502007(uiop/package:define-package :uiop/pathname
    2051   (:nicknames :asdf/pathname)
    2052   (:recycle :uiop/pathname :asdf/pathname :asdf)
     2008  (:nicknames :asdf/pathname) ;; deprecated. Used by ceramic
    20532009  (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os)
    20542010  (:export
     
    20932049that is a list and not a string."
    20942050    (cond
    2095       #-(or cmu sbcl scl) ;; these implementations already normalize directory components.
     2051      #-(or cmucl sbcl scl) ;; these implementations already normalize directory components.
    20962052      ((stringp directory) `(:absolute ,directory))
    20972053      ((or (null directory)
     
    21362092  ;; This will be :unspecific if supported, or NIL if not.
    21372093  (defparameter *unspecific-pathname-type*
    2138     #+(or abcl allegro clozure cmu genera lispworks sbcl scl) :unspecific
     2094    #+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific
    21392095    #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil
    21402096    "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")
    21412097
    2142   (defun make-pathname* (&rest keys &key (directory nil)
    2143                                       host (device () #+allegro devicep) name type version defaults
     2098  (defun make-pathname* (&rest keys &key directory host device name type version defaults
    21442099                                      #+scl &allow-other-keys)
    21452100    "Takes arguments like CL:MAKE-PATHNAME in the CLHS, and
    21462101   tries hard to make a pathname that will actually behave as documented,
    2147    despite the peculiarities of each implementation"
    2148     ;; TODO: reimplement defaulting for MCL, whereby an explicit NIL should override the defaults.
    2149     (declare (ignorable host device directory name type version defaults))
    2150     (apply 'make-pathname
    2151            (append
    2152             #+allegro (when (and devicep (null device)) `(:device :unspecific))
    2153             keys)))
     2102   despite the peculiarities of each implementation. DEPRECATED: just use MAKE-PATHNAME."
     2103    (declare (ignore host device directory name type version defaults))
     2104    (apply 'make-pathname keys))
    21542105
    21552106  (defun make-pathname-component-logical (x)
     
    21642115    "Take a PATHNAME's directory, name, type and version components,
    21652116and make a new pathname with corresponding components and specified logical HOST"
    2166     (make-pathname*
     2117    (make-pathname
    21672118     :host host
    21682119     :directory (make-pathname-component-logical (pathname-directory pathname))
     
    22072158                       (merge-pathname-directory-components directory (pathname-directory defaults))
    22082159                       (unspecific-handler defaults))))
    2209           (make-pathname* :host host :device device :directory directory
    2210                           :name (funcall unspecific-handler name)
    2211                           :type (funcall unspecific-handler type)
    2212                           :version (funcall unspecific-handler version))))))
     2160          (make-pathname :host host :device device :directory directory
     2161                         :name (funcall unspecific-handler name)
     2162                         :type (funcall unspecific-handler type)
     2163                         :version (funcall unspecific-handler version))))))
    22132164
    22142165  (defun logical-pathname-p (x)
     
    22352186    ;; MCL has issues with make-pathname, nil and defaulting
    22362187    (declare (ignorable defaults))
    2237     #.`(make-pathname* :directory nil :name nil :type nil :version nil
    2238                        :device (or #+(and mkcl unix) :unspecific)
    2239                        :host (or #+cmu lisp::*unix-host* #+(and mkcl unix) "localhost")
    2240                        #+scl ,@'(:scheme nil :scheme-specific-part nil
    2241                                  :username nil :password nil :parameters nil :query nil :fragment nil)
    2242                        ;; the default shouldn't matter, but we really want something physical
    2243                        #-mcl ,@'(:defaults defaults)))
     2188    #.`(make-pathname :directory nil :name nil :type nil :version nil
     2189                      :device (or #+(and mkcl unix) :unspecific)
     2190                      :host (or #+cmucl lisp::*unix-host* #+(and mkcl unix) "localhost")
     2191                      #+scl ,@'(:scheme nil :scheme-specific-part nil
     2192                                :username nil :password nil :parameters nil :query nil :fragment nil)
     2193                      ;; the default shouldn't matter, but we really want something physical
     2194                      #-mcl ,@'(:defaults defaults)))
    22442195
    22452196  (defvar *nil-pathname* (nil-pathname (physicalize-pathname (user-homedir-pathname)))
     
    23192270Returns the (parsed) PATHNAME when true"
    23202271    (when pathname
    2321       (let* ((pathname (pathname pathname))
    2322              (name (pathname-name pathname)))
    2323         (when (not (member name '(nil :unspecific "") :test 'equal))
     2272      (let ((pathname (pathname pathname)))
     2273        (unless (and (member (pathname-name pathname) '(nil :unspecific "") :test 'equal)
     2274                     (member (pathname-type pathname) '(nil :unspecific "") :test 'equal))
    23242275          pathname)))))
    23252276
     
    23382289Unix pathname /foo/bar/baz/file.type then return /foo/bar/"
    23392290    (when pathname
    2340       (make-pathname* :name nil :type nil :version nil
    2341                       :directory (merge-pathname-directory-components
    2342                                   '(:relative :back) (pathname-directory pathname))
    2343                       :defaults pathname)))
     2291      (make-pathname :name nil :type nil :version nil
     2292                     :directory (merge-pathname-directory-components
     2293                                 '(:relative :back) (pathname-directory pathname))
     2294                     :defaults pathname)))
    23442295
    23452296  (defun directory-pathname-p (pathname)
     
    23762327       pathspec)
    23772328      (t
    2378        (make-pathname* :directory (append (or (normalize-pathname-directory-component
    2379                                                (pathname-directory pathspec))
    2380                                               (list :relative))
    2381                                           (list (file-namestring pathspec)))
    2382                        :name nil :type nil :version nil :defaults pathspec)))))
     2329       (make-pathname :directory (append (or (normalize-pathname-directory-component
     2330                                              (pathname-directory pathspec))
     2331                                             (list :relative))
     2332                                         (list (file-namestring pathspec)))
     2333                      :name nil :type nil :version nil :defaults pathspec)))))
    23832334
    23842335
     
    25132464               (split-name-type filename)))
    25142465          (apply 'ensure-pathname
    2515                  (make-pathname*
     2466                 (make-pathname
    25162467                  :directory (unless file-only (cons relative path))
    25172468                  :name name :type type
     
    25822533  (defun pathname-root (pathname)
    25832534    "return the root directory for the host and device of given PATHNAME"
    2584     (make-pathname* :directory '(:absolute)
    2585                     :name nil :type nil :version nil
    2586                     :defaults pathname ;; host device, and on scl, *some*
    2587                     ;; scheme-specific parts: port username password, not others:
    2588                     . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
     2535    (make-pathname :directory '(:absolute)
     2536                   :name nil :type nil :version nil
     2537                   :defaults pathname ;; host device, and on scl, *some*
     2538                   ;; scheme-specific parts: port username password, not others:
     2539                   . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
    25892540
    25902541  (defun pathname-host-pathname (pathname)
    25912542    "return a pathname with the same host as given PATHNAME, and all other fields NIL"
    2592     (make-pathname* :directory nil
    2593                     :name nil :type nil :version nil :device nil
    2594                     :defaults pathname ;; host device, and on scl, *some*
    2595                     ;; scheme-specific parts: port username password, not others:
    2596                     . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
     2543    (make-pathname :directory nil
     2544                   :name nil :type nil :version nil :device nil
     2545                   :defaults pathname ;; host device, and on scl, *some*
     2546                   ;; scheme-specific parts: port username password, not others:
     2547                   . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
    25972548
    25982549  (defun ensure-absolute-pathname (path &optional defaults (on-error 'error))
     
    26612612    "A pathname object with wildcards for matching any file in a given directory")
    26622613  (defparameter *wild-directory*
    2663     (make-pathname* :directory `(:relative ,*wild-directory-component*)
    2664                     :name nil :type nil :version nil)
     2614    (make-pathname :directory `(:relative ,*wild-directory-component*)
     2615                   :name nil :type nil :version nil)
    26652616    "A pathname object with wildcards for matching any subdirectory")
    26662617  (defparameter *wild-inferiors*
    2667     (make-pathname* :directory `(:relative ,*wild-inferiors-component*)
    2668                     :name nil :type nil :version nil)
     2618    (make-pathname :directory `(:relative ,*wild-inferiors-component*)
     2619                   :name nil :type nil :version nil)
    26692620    "A pathname object with wildcards for matching any recursive subdirectory")
    26702621  (defparameter *wild-path*
     
    26932644    "Given a PATHNAME, return a relative pathname with otherwise the same components"
    26942645    (let ((p (pathname pathspec)))
    2695       (make-pathname*
     2646      (make-pathname
    26962647       :directory (relativize-directory-component (pathname-directory p))
    26972648       :defaults p)))
     
    26992650  (defun directory-separator-for-host (&optional (pathname *default-pathname-defaults*))
    27002651    "Given a PATHNAME, return the character used to delimit directory names on this host and device."
    2701     (let ((foo (make-pathname* :directory '(:absolute "FOO") :defaults pathname)))
     2652    (let ((foo (make-pathname :directory '(:absolute "FOO") :defaults pathname)))
    27022653      (last-char (namestring foo))))
    27032654
     
    27232674          (split-unix-namestring-directory-components root-string :ensure-directory t)
    27242675        (declare (ignore relative filename))
    2725         (let ((new-base
    2726                 (make-pathname* :defaults root :directory `(:absolute ,@path))))
     2676        (let ((new-base (make-pathname :defaults root :directory `(:absolute ,@path))))
    27272677          (translate-pathname absolute-pathname wild-root (wilden new-base))))))
    27282678
     
    27462696                (setf prefix (strcat scheme prefix)))
    27472697              (assert (and directory (eq (first directory) :absolute)))
    2748               (make-pathname* :directory `(:absolute ,prefix ,@(rest directory))
    2749                               :defaults pathname)))
     2698              (make-pathname :directory `(:absolute ,prefix ,@(rest directory))
     2699                             :defaults pathname)))
    27502700        pathname)))
    27512701
     
    27862736
    27872737(uiop/package:define-package :uiop/filesystem
    2788   (:nicknames :asdf/filesystem)
    2789   (:recycle :uiop/filesystem :asdf/pathname :asdf)
    27902738  (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname)
    27912739  (:export
     
    28182766      (let ((p (pathname x)))
    28192767        #+clozure (with-pathname-defaults () (ccl:native-translated-namestring p)) ; see ccl bug 978
    2820         #+(or cmu scl) (ext:unix-namestring p nil)
     2768        #+(or cmucl scl) (ext:unix-namestring p nil)
    28212769        #+sbcl (sb-ext:native-namestring p)
    2822         #-(or clozure cmu sbcl scl)
     2770        #-(or clozure cmucl sbcl scl)
    28232771        (os-cond
    28242772         ((os-unix-p) (unix-namestring p))
     
    28332781               (with-pathname-defaults ()
    28342782                 #+clozure (ccl:native-to-pathname string)
     2783                 #+cmucl (uiop/os::parse-unix-namestring* string)
    28352784                 #+sbcl (sb-ext:parse-native-namestring string)
    2836                  #-(or clozure sbcl)
     2785                 #+scl (lisp::parse-unix-namestring string)
     2786                 #-(or clozure cmucl sbcl scl)
    28372787                 (os-cond
    28382788                  ((os-unix-p) (parse-unix-namestring string :ensure-directory ensure-directory))
     
    29192869            (probe-file p)
    29202870            (and
    2921              #+(or cmu scl) (unix:unix-stat (ext:unix-namestring p))
     2871             #+(or cmucl scl) (unix:unix-stat (ext:unix-namestring p))
    29222872             #+(and lispworks unix) (system:get-file-stat p)
    29232873             #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring p))
    2924              #-(or cmu (and lispworks unix) sbcl scl) (file-write-date p)
     2874             #-(or cmucl (and lispworks unix) sbcl scl) (file-write-date p)
    29252875             p))))))
    29262876
     
    29492899                               #+(or clozure digitool) '(:follow-links nil)
    29502900                               #+clisp '(:circle t :if-does-not-exist :ignore)
    2951                                #+(or cmu scl) '(:follow-links nil :truenamep nil)
     2901                               #+(or cmucl scl) '(:follow-links nil :truenamep nil)
    29522902                               #+lispworks '(:link-transparency nil)
    29532903                               #+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl nil)
     
    30152965           #-(or abcl cormanlisp genera xcl)
    30162966           (wild (merge-pathnames*
    3017                   #-(or abcl allegro cmu lispworks sbcl scl xcl)
     2967                  #-(or abcl allegro cmucl lispworks sbcl scl xcl)
    30182968                  *wild-directory*
    3019                   #+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*"
     2969                  #+(or abcl allegro cmucl lispworks sbcl scl xcl) "*.*"
    30202970                  directory))
    30212971           (dirs
     
    30262976             #+(or abcl xcl) (system:list-directory directory)
    30272977             #+cormanlisp (cl::directory-subdirs directory)
    3028              #+genera (fs:directory-list directory))
    3029            #+(or abcl allegro cmu genera lispworks sbcl scl xcl)
     2978             #+genera (handler-case (fs:directory-list directory) (fs:directory-not-found () nil)))
     2979           #+(or abcl allegro cmucl genera lispworks sbcl scl xcl)
    30302980           (dirs (loop :for x :in dirs
    30312981                       :for d = #+(or abcl xcl) (extensions:probe-directory x)
    30322982                       #+allegro (excl:probe-directory x)
    3033                        #+(or cmu sbcl scl) (directory-pathname-p x)
     2983                       #+(or cmucl sbcl scl) (directory-pathname-p x)
    30342984                       #+genera (getf (cdr x) :directory)
    30352985                       #+lispworks (lw:file-directory-p x)
    30362986                       :when d :collect #+(or abcl allegro xcl) d
    30372987                         #+genera (ensure-directory-pathname (first x))
    3038                        #+(or cmu lispworks sbcl scl) x)))
     2988                       #+(or cmucl lispworks sbcl scl) x)))
    30392989      (filter-logical-directory-results
    30402990       directory dirs
     
    30813031            (if-let (parent
    30823032                     (ignore-errors
    3083                       (probe-file* (make-pathname* :directory `(:absolute ,@(reverse up-components))
    3084                                                    :name nil :type nil :version nil :defaults p))))
     3033                      (probe-file* (make-pathname :directory `(:absolute ,@(reverse up-components))
     3034                                                  :name nil :type nil :version nil :defaults p))))
    30853035              (if-let (simplified
    30863036                       (ignore-errors
    30873037                        (merge-pathnames*
    3088                          (make-pathname* :directory `(:relative ,@down-components)
    3089                                          :defaults p)
     3038                         (make-pathname :directory `(:relative ,@down-components)
     3039                                        :defaults p)
    30903040                         (ensure-directory-pathname parent))))
    30913041                (return simplified)))
     
    33333283            ;;#+clisp custom:*lib-directory* ; causes failure in asdf-pathname-test(!)
    33343284            #+clozure #p"ccl:"
    3335             #+cmu (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:")))
     3285            #+cmucl (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:")))
    33363286            #+gcl system::*system-directory*
    33373287            #+lispworks lispworks:*lispworks-directory*
     
    33873337    #+clisp (ext:delete-directory directory-pathname)
    33883338    #+clozure (ccl::delete-empty-directory directory-pathname)
    3389     #+(or cmu scl) (multiple-value-bind (ok errno)
     3339    #+(or cmucl scl) (multiple-value-bind (ok errno)
    33903340                       (unix:unix-rmdir (native-namestring directory-pathname))
    33913341                     (unless ok
    3392                        #+cmu (error "Error number ~A when trying to delete directory ~A"
     3342                       #+cmucl (error "Error number ~A when trying to delete directory ~A"
    33933343                                    errno directory-pathname)
    33943344                       #+scl (error "~@<Error deleting ~S: ~A~@:>"
     
    34033353               `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname)))
    34043354    #+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname)))
    3405     #-(or abcl allegro clasp clisp clozure cmu cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl)
     3355    #-(or abcl allegro clasp clisp clozure cmucl cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl)
    34063356    (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera
    34073357
     
    34373387              'delete-directory-tree directory-pathname))
    34383388         (:ignore nil)))
    3439       #-(or allegro cmu clozure genera sbcl scl)
     3389      #-(or allegro cmucl clozure genera sbcl scl)
    34403390      ((os-unix-p) ;; On Unix, don't recursively walk the directory and delete everything in Lisp,
    34413391       ;; except on implementations where we can prevent DIRECTORY from following symlinks;
     
    34643414
    34653415(uiop/package:define-package :uiop/stream
    3466   (:nicknames :asdf/stream)
    3467   (:recycle :uiop/stream :asdf/stream :asdf)
    34683416  (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname :uiop/filesystem)
    34693417  (:export
     
    34963444(with-upgradability ()
    34973445  (defvar *default-stream-element-type*
    3498     (or #+(or abcl cmu cormanlisp scl xcl) 'character
     3446    (or #+(or abcl cmucl cormanlisp scl xcl) 'character
    34993447        #+lispworks 'lw:simple-char
    35003448        :default)
     
    35073455    (setf *stdin*
    35083456          #.(or #+clozure 'ccl::*stdin*
    3509                 #+(or cmu scl) 'system:*stdin*
     3457                #+(or cmucl scl) 'system:*stdin*
    35103458                #+(or clasp ecl) 'ext::+process-standard-input+
    35113459                #+sbcl 'sb-sys:*stdin*
     
    35183466    (setf *stdout*
    35193467          #.(or #+clozure 'ccl::*stdout*
    3520                 #+(or cmu scl) 'system:*stdout*
     3468                #+(or cmucl scl) 'system:*stdout*
    35213469                #+(or clasp ecl) 'ext::+process-standard-output+
    35223470                #+sbcl 'sb-sys:*stdout*
     
    35303478          #.(or #+allegro 'excl::*stderr*
    35313479                #+clozure 'ccl::*stderr*
    3532                 #+(or cmu scl) 'system:*stderr*
     3480                #+(or cmucl scl) 'system:*stderr*
    35333481                #+(or clasp ecl) 'ext::+process-error-output+
    35343482                #+sbcl 'sb-sys:*stderr*
     
    38153763          (loop
    38163764            :with buffer-size = (or buffer-size 8192)
    3817             :for buffer = (make-array (list buffer-size) :element-type (or element-type 'character))
     3765            :with buffer = (make-array (list buffer-size) :element-type (or element-type 'character))
    38183766            :for end = (read-sequence buffer input)
    38193767            :until (zerop end)
     
    40283976If WANT-STREAM-P is true (the defaults to T), then THUNK will then be CALL-FUNCTION'ed
    40293977with the stream and the pathname (if WANT-PATHNAME-P is true, defaults to T),
    4030 and stream with be closed after the THUNK exits (either normally or abnormally).
     3978and stream will be closed after the THUNK exits (either normally or abnormally).
    40313979If WANT-STREAM-P is false, then WANT-PATHAME-P must be true, and then
    40323980THUNK is only CALL-FUNCTION'ed after the stream is closed, with the pathname as argument.
     
    41654113
    41664114(uiop/package:define-package :uiop/image
    4167   (:nicknames :asdf/image)
    4168   (:recycle :uiop/image :asdf/image :xcvb-driver)
    41694115  (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/stream :uiop/os)
    41704116  (:export
     
    42324178    #+clozure (ccl:quit code)
    42334179    #+cormanlisp (win32:exitprocess code)
    4234     #+(or cmu scl) (unix:unix-exit code)
     4180    #+(or cmucl scl) (unix:unix-exit code)
    42354181    #+gcl (system:quit code)
    42364182    #+genera (error "~S: You probably don't want to Halt Genera. (code: ~S)" 'quit code)
     
    42434189                 (exit `(,exit :code code :abort (not finish-output)))
    42444190                 (quit `(,quit :unix-status code :recklessly-p (not finish-output)))))
    4245     #-(or abcl allegro clasp clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
     4191    #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
    42464192    (error "~S called with exit code ~S but there's no quitting on this implementation" 'quit code))
    42474193
     
    42864232      #+mcl (ccl:print-call-history :detailed-p nil)
    42874233      (finish-output stream))
    4288     #+(or cmu scl)
     4234    #+(or cmucl scl)
    42894235    (let ((debug:*debug-print-level* *print-level*)
    42904236          (debug:*debug-print-length* *print-length*))
     
    43904336    #+clisp (coerce (ext:argv) 'list)
    43914337    #+clozure ccl:*command-line-argument-list*
    4392     #+(or cmu scl) extensions:*command-line-strings*
     4338    #+(or cmucl scl) extensions:*command-line-strings*
    43934339    #+gcl si:*command-args*
    43944340    #+(or genera mcl) nil
     
    43974343    #+sbcl sb-ext:*posix-argv*
    43984344    #+xcl system:*argv*
    4399     #-(or abcl allegro clasp clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
     4345    #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
    44004346    (error "raw-command-line-arguments not implemented yet"))
    44014347
     
    44264372      ((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 !
    44274373       ;; NB: not currently available on ABCL, Corman, Genera, MCL
    4428        (or #+(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl)
     4374       (or #+(or allegro clisp clozure cmucl gcl lispworks sbcl scl xcl)
    44294375           (first (raw-command-line-arguments))
    44304376           #+(or clasp ecl) (si:argv 0) #+mkcl (mkcl:argv 0)))
     
    45164462    (call-image-dump-hook)
    45174463    (setf *image-restored-p* nil)
    4518     #-(or clisp clozure cmu lispworks sbcl scl)
     4464    #-(or clisp clozure cmucl lispworks sbcl scl)
    45194465    (when executable
    45204466      (error "Dumping an executable is not supported on this implementation! Aborting."))
     
    45444490            (dump path))
    45454491          (dump t)))
    4546     #+(or cmu scl)
     4492    #+(or cmucl scl)
    45474493    (progn
    45484494      (ext:gc :full t)
     
    45504496      (setf ext::*gc-run-time* 0)
    45514497      (apply 'ext:save-lisp filename
    4552              #+cmu :executable #+cmu t
     4498             #+cmucl :executable #+cmucl t
    45534499             (when executable '(:init-function restore-image :process-command-line nil))))
    45544500    #+gcl
     
    45734519              ;; the default is :console - only works with SBCL 1.1.15 or later.
    45744520              (when application-type (list :application-type application-type)))))
    4575     #-(or allegro clisp clozure cmu gcl lispworks sbcl scl)
     4521    #-(or allegro clisp clozure cmucl gcl lispworks sbcl scl)
    45764522    (error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%"
    45774523           'dump-image filename (nth-value 1 (implementation-type))))
     
    46374583
    46384584(uiop/package:define-package :uiop/run-program
    4639   (:nicknames :asdf/run-program)
    4640   (:recycle :uiop/run-program :asdf/run-program :xcvb-driver)
     4585  (:nicknames :asdf/run-program) ; OBSOLETE. Used by cl-sane, printv.
    46414586  (:use :uiop/common-lisp :uiop/package :uiop/utility
    46424587   :uiop/pathname :uiop/os :uiop/filesystem :uiop/stream)
     
    55555500
    55565501(uiop/package:define-package :uiop/lisp-build
    5557   (:nicknames :asdf/lisp-build)
    5558   (:recycle :uiop/lisp-build :asdf/lisp-build :asdf)
     5502  (:nicknames :asdf/lisp-build) ;; OBSOLETE, used by slime/contrib/swank-asdf.lisp
    55595503  (:use :uiop/common-lisp :uiop/package :uiop/utility
    55605504   :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image)
     
    56195563        #+clozure '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety*
    56205564                    ccl::*nx-debug* ccl::*nx-cspeed*)
    5621         #+(or cmu scl) '(c::*default-cookie*)
     5565        #+(or cmucl scl) '(c::*default-cookie*)
    56225566        #+(and ecl (not clasp)) (unless (use-ecl-byte-compiler-p) '(c::*speed* c::*space* c::*safety* c::*debug*))
    56235567        #+clasp '()
     
    56285572  (defun get-optimization-settings ()
    56295573    "Get current compiler optimization settings, ready to PROCLAIM again"
    5630     #-(or abcl allegro clasp clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
     5574    #-(or abcl allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl scl xcl)
    56315575    (warn "~S does not support ~S. Please help me fix that."
    56325576          'get-optimization-settings (implementation-type))
    5633     #+(or abcl allegro clasp clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
    5634     (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity)))
     5577    #+(or abcl allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl scl xcl)
     5578    (let ((settings '(speed space safety debug compilation-speed #+(or cmucl scl) c::brevity)))
    56355579      #.`(loop #+(or allegro clozure)
    56365580               ,@'(:with info = #+allegro (sys:declaration-information 'optimize)
     
    56415585                            #+clisp (gethash x system::*optimize* 1)
    56425586                            #+(or abcl clasp ecl mkcl xcl) (symbol-value v)
    5643                             #+(or cmu scl) (slot-value c::*default-cookie*
     5587                            #+(or cmucl scl) (slot-value c::*default-cookie*
    56445588                                                       (case x (compilation-speed 'c::cspeed)
    56455589                                                             (otherwise x)))
     
    56835627    (append
    56845628     ;;#+clozure '(ccl:compiler-warning)
    5685      #+cmu '("Deleting unreachable code.")
     5629     #+cmucl '("Deleting unreachable code.")
    56865630     #+lispworks '("~S being redefined in ~A (previously in ~A)."
    56875631                   "~S defined more than once in ~A.") ;; lispworks gets confused by eval-when.
     
    58685812                        :args (destructuring-bind (fun . more) args
    58695813                                (cons (symbolify-function-name fun) more))))))
    5870   #+(or cmu scl)
     5814  #+(or cmucl scl)
    58715815  (defun reify-undefined-warning (warning)
    58725816    ;; Extracting undefined-warnings from the compilation-unit
     
    59205864              (let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
    59215865                (ccl::deferred-warnings.warnings mdw))))
    5922     #+(or cmu scl)
     5866    #+(or cmucl scl)
    59235867    (when lisp::*in-compilation-unit*
    59245868      ;; Try to send nothing through the pipe if nothing needs to be accumulated
     
    59665910      (appendf (ccl::deferred-warnings.warnings dw)
    59675911               (mapcar 'unreify-deferred-warning reified-deferred-warnings)))
    5968     #+(or cmu scl)
     5912    #+(or cmucl scl)
    59695913    (dolist (item reified-deferred-warnings)
    59705914      ;; Each item is (symbol . adjustment) where the adjustment depends on the symbol.
     
    60295973      (let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
    60305974        (setf (ccl::deferred-warnings.warnings mdw) nil)))
    6031     #+(or cmu scl)
     5975    #+(or cmucl scl)
    60325976    (when lisp::*in-compilation-unit*
    60335977      (setf c::*undefined-warnings* nil
     
    61956139It ensures that the OUTPUT-FILE value is only returned and
    61966140the file only actually created if the compilation was successful,
    6197 even though your implementation may not do that, and including
    6198 an optional call to an user-provided consistency check function COMPILE-CHECK;
     6141even though your implementation may not do that. It also checks an optional
     6142user-provided consistency function COMPILE-CHECK to determine success;
    61996143it will call this function if not NIL at the end of the compilation
    62006144with the arguments sent to COMPILE-FILE*, except with :OUTPUT-FILE TMP-FILE
     
    62036147*COMPILE-FILE-FAILURE-BEHAVIOUR* and *COMPILE-FILE-WARNINGS-BEHAVIOUR*
    62046148with appropriate implementation-dependent defaults,
    6205 and if a failure (respectively warnings) are reported by COMPILE-FILE
    6206 with consider it an error unless the respective behaviour flag
     6149and if a failure (respectively warnings) are reported by COMPILE-FILE,
     6150it will consider that an error unless the respective behaviour flag
    62076151is one of :SUCCESS :WARN :IGNORE.
    62086152If WARNINGS-FILE is defined, deferred warnings are saved to that file.
     
    62106154On implementations that erroneously do not recognize standard keyword arguments,
    62116155it will filter them appropriately."
    6212     #+(or clasp ecl) (when (and object-file (equal (compile-file-type) (pathname object-file)))
    6213             (format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%"
    6214                     'compile-file* output-file object-file)
    6215             (rotatef output-file object-file))
     6156    #+(or clasp ecl)
     6157    (when (and object-file (equal (compile-file-type) (pathname object-file)))
     6158      (format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%"
     6159              'compile-file* output-file object-file)
     6160      (rotatef output-file object-file))
    62166161    (let* ((keywords (remove-plist-keys
    62176162                      `(:output-file :compile-check :warnings-file
     
    62246169             (unless (use-ecl-byte-compiler-p)
    62256170               (or object-file
    6226                    #+ecl(compile-file-pathname output-file :type :object)
     6171                   #+ecl (compile-file-pathname output-file :type :object)
    62276172                   #+clasp (compile-file-pathname output-file :output-type :object))))
    62286173           #+mkcl
     
    63456290
    63466291(uiop/package:define-package :uiop/configuration
    6347   (:nicknames :asdf/configuration)
    6348   (:recycle :uiop/configuration :asdf/configuration :asdf)
     6292  (:recycle :uiop/configuration :asdf/configuration) ;; necessary to upgrade from 2.27.
    63496293  (:use :uiop/common-lisp :uiop/utility
    63506294   :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/lisp-build)
     
    65426486        ;; "relative to the root of the source pathname's host and device".
    65436487        (return-from resolve-absolute-location
    6544           (let ((p (make-pathname* :directory '(:relative))))
     6488          (let ((p (make-pathname :directory '(:relative))))
    65456489            (if wilden (wilden p) p))))
    65466490       ((eql :home) (user-homedir-pathname))
     
    67596703
    67606704(uiop/package:define-package :uiop/backward-driver
    6761   (:nicknames :asdf/backward-driver)
    6762   (:recycle :uiop/backward-driver :asdf/backward-driver :asdf)
    67636705  (:use :uiop/common-lisp :uiop/package :uiop/utility
    67646706   :uiop/pathname :uiop/stream :uiop/os :uiop/image
    67656707   :uiop/run-program :uiop/lisp-build :uiop/configuration)
    67666708  (:export
    6767    #:coerce-pathname #:component-name-to-pathname-components
    6768    #+(or clasp ecl mkcl) #:compile-file-keeping-object
     6709   #:coerce-pathname
    67696710   #:user-configuration-directories #:system-configuration-directories
    67706711   #:in-first-directory #:in-user-configuration-directory #:in-system-configuration-directory
     
    67776718  (defun coerce-pathname (name &key type defaults)
    67786719    ;; For backward-compatibility only, for people using internals
    6779     ;; Reported users in quicklisp: hu.dwim.asdf, asdf-utils, xcvb
    6780     ;; Will be removed after 2014-01-16.
     6720    ;; Reported users in quicklisp 2015-11: hu.dwim.asdf (removed in next release)
     6721    ;; Will be removed after 2015-12.
    67816722    ;;(warn "Please don't use ASDF::COERCE-PATHNAME. Use ASDF/PATHNAME:PARSE-UNIX-NAMESTRING.")
    67826723    (parse-unix-namestring name :type type :defaults defaults))
    6783 
    6784   (defun component-name-to-pathname-components (unix-style-namestring
    6785                                                  &key force-directory force-relative)
    6786     ;; Will be removed after 2014-01-16.
    6787     ;; (warn "Please don't use ASDF::COMPONENT-NAME-TO-PATHNAME-COMPONENTS, use SPLIT-UNIX-NAMESTRING-DIRECTORY-COMPONENTS")
    6788     (multiple-value-bind (relabs path filename file-only)
    6789         (split-unix-namestring-directory-components
    6790          unix-style-namestring :ensure-directory force-directory)
    6791       (declare (ignore file-only))
    6792       (when (and force-relative (not (eq relabs :relative)))
    6793         (error (compatfmt "~@<Absolute pathname designator not allowed: ~3i~_~S~@:>")
    6794                unix-style-namestring))
    6795       (values relabs path filename)))
    6796 
    6797   #+(or clasp ecl mkcl)
    6798   (defun compile-file-keeping-object (&rest args) (apply #'compile-file* args))
    67996724
    68006725  ;; Backward compatibility for ASDF 2.27 to 3.1.4
     
    68306755
    68316756(uiop/package:define-package :uiop/driver
    6832   (:nicknames :uiop :asdf/driver :asdf-driver :asdf-utils)
     6757  (:nicknames :uiop :asdf/driver) ;; asdf/driver is obsolete (uiop isn't);
     6758  ;; but asdf/driver is still used by swap-bytes, static-vectors.
    68336759  (:use :uiop/common-lisp)
    68346760   ;; NB: not reexporting uiop/common-lisp
     
    68386764  (:use-reexport
    68396765   :uiop/package :uiop/utility
    6840    :uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image
    6841    :uiop/run-program :uiop/lisp-build
    6842    :uiop/configuration :uiop/backward-driver))
     6766   :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image
     6767   :uiop/run-program :uiop/lisp-build :uiop/configuration :uiop/backward-driver))
    68436768
    68446769;; Provide both lowercase and uppercase, to satisfy more people.
     
    68546779   #:asdf-version #:*previous-asdf-versions* #:*asdf-version*
    68556780   #:asdf-message #:*verbose-out*
    6856    #:upgrading-p #:when-upgrading #:upgrade-asdf #:asdf-upgrade-error #:defparameter*
     6781   #:upgrading-p #:when-upgrading #:upgrade-asdf #:defparameter*
    68576782   #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf
    68586783   ;; There will be no symbol left behind!
     
    68766801              (null "1.0"))))))
    68776802  ;; Important: define *p-a-v* /before/ *a-v* so that it initializes correctly.
    6878   (defvar *previous-asdf-versions* (if-let (previous (asdf-version)) (list previous)))
     6803  (defvar *previous-asdf-versions*
     6804    (let ((previous (asdf-version)))
     6805      (when previous
     6806        ;; Punt on hard package upgrade: from ASDF1 or ASDF2
     6807        (when (version< previous "2.27") ;; 2.27 is the first to have the :asdf3 feature.
     6808          (let ((away (format nil "~A-~A" :asdf previous)))
     6809            (rename-package :asdf away)
     6810            (when *load-verbose*
     6811              (format t "~&; Renamed old ~A package away to ~A~%" :asdf away)))))
     6812        (list previous)))
    68796813  (defvar *asdf-version* nil)
    68806814  ;; We need to clear systems from versions yet older than the below:
     
    69136847         ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
    69146848         ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
    6915          (asdf-version "3.1.6")
     6849         (asdf-version "3.1.7")
    69166850         (existing-version (asdf-version)))
    69176851    (setf *asdf-version* asdf-version)
     
    69276861          ;; NB: it's too late to do anything about functions in UIOP!
    69286862          ;; If you introduce some critically incompatibility there, you must change name.
    6929           '(#:component-relative-pathname #:component-parent-pathname ;; component
    6930             #:source-file-type
    6931             #:find-system #:system-source-file #:system-relative-pathname ;; system
    6932             #:find-component ;; find-component
    6933             #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
    6934             #:component-depends-on #:operation-done-p #:component-depends-on
    6935             #:traverse ;; backward-interface
    6936             #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan
    6937             #:operate  ;; operate
    6938             #:parse-component-form ;; defsystem
    6939             #:apply-output-translations ;; output-translations
    6940             #:process-output-translations-directive
    6941             #:inherit-source-registry #:process-source-registry ;; source-registry
    6942             #:process-source-registry-directive
    6943             #:trivial-system-p)) ;; bundle
     6863          '()) ;; empty now that we don't unintern, but wholly punt on ASDF 2.26 or earlier.
    69446864        (redefined-classes
    69456865          ;; redefining the classes causes interim circularities
     
    69636883
    69646884(with-upgradability ()
    6965   (defun asdf-upgrade-error ()
    6966     ;; Important notice for whom it concerns. The crux of the matter is that
    6967     ;; TRAVERSE can be completely refactored, and so after the find-system returns, it's too late.
    6968     (error "When a system transitively depends on ASDF, it must :defsystem-depends-on (:asdf)~%~
    6969           Otherwise, when you upgrade from ASDF 2, you must do it before you operate on any system.~%"))
    6970 
    69716885  (defun cleanup-upgraded-asdf (&optional (old-version (first *previous-asdf-versions*)))
    69726886    (let ((new-version (asdf-version)))
     
    70736987    ;; run-time.  fortunately, inheritance means we only need this kludge here in
    70746988    ;; order to fix all conditions that build on it.  -- rgr, 28-Jul-02.]
    7075     #+cmu (:report print-object))
     6989    #+cmucl (:report print-object))
    70766990
    70776991  (define-condition duplicate-names (system-definition-error)
     
    71117025     (in-order-to :initform nil :initarg :in-order-to
    71127026                  :accessor component-in-order-to)
    7113      ;; methods defined using the "inline" style inside a defsystem form:
    7114      ;; need to store them somewhere so we can delete them when the system
    7115      ;; is re-evaluated.
    7116      (inline-methods :accessor component-inline-methods :initform nil) ;; OBSOLETE! DELETE THIS IF NO ONE USES.
     7027     ;; Methods defined using the "inline" style inside a defsystem form:
     7028     ;; we store them here so we can delete them when the system is re-evaluated.
     7029     (inline-methods :accessor component-inline-methods :initform nil)
    71177030     ;; ASDF4: rename it from relative-pathname to specified-pathname. It need not be relative.
    71187031     ;; There is no initform and no direct accessor for this specified pathname,
     
    75037416   #:coerce-name #:primary-system-name #:coerce-filename
    75047417   #:find-system #:locate-system #:load-asd
    7505    #:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems
     7418   #:system-registered-p #:register-system #:registered-systems* #:registered-systems
     7419   #:clear-system #:map-systems
    75067420   #:missing-component #:missing-requires #:missing-parent
    75077421   #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error
     
    75687482    (gethash (coerce-name name) *defined-systems*))
    75697483
     7484  (defun registered-systems* ()
     7485    (loop :for registered :being :the :hash-values :of *defined-systems*
     7486          :collect (cdr registered)))
     7487
    75707488  (defun registered-systems ()
    7571     (loop :for registered :being :the :hash-values :of *defined-systems*
    7572           :collect (coerce-name (cdr registered))))
     7489    (mapcar 'coerce-name (registered-systems*)))
    75737490
    75747491  (defun register-system (system)
     
    77897706
    77907707  (defun find-system-if-being-defined (name)
    7791     ;; notable side effect: mark the system as being defined, to avoid infinite loops
     7708    ;; NB: this depends on a corresponding side-effect in parse-defsystem;
     7709    ;; this protocol may change somewhat in the future.
    77927710    (first (gethash `(find-system ,(coerce-name name)) *asdf-cache*)))
    77937711
     
    78107728                (pathname-directory-pathname (physicalize-pathname pathname))))
    78117729          (handler-bind
    7812               ((error #'(lambda (condition)
    7813                           (error 'load-system-definition-error
    7814                                  :name name :pathname pathname
    7815                                 :condition condition))))
     7730              (((and error (not missing-component))
     7731                 #'(lambda (condition)
     7732                     (error 'load-system-definition-error
     7733                            :name name :pathname pathname :condition condition))))
    78167734            (asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%")
    78177735                          name pathname)
     
    84478365(with-upgradability ()
    84488366  (defgeneric component-operation-time (operation component)) ;; ASDF4: hide it behind plan-action-stamp
     8367  (defgeneric (setf component-operation-time) (time operation component))
    84498368  (define-convenience-action-methods component-operation-time (operation component))
    84508369
     
    84838402    (gethash (type-of o) (component-operation-times c)))
    84848403
     8404  (defmethod (setf component-operation-time) (stamp (o operation) (c component))
     8405    (setf (gethash (type-of o) (component-operation-times c)) stamp))
     8406
    84858407  (defmethod mark-operation-done ((o operation) (c component))
    8486     (setf (gethash (type-of o) (component-operation-times c))
    8487           (compute-action-stamp nil o c :just-done t))))
     8408    (setf (component-operation-time o c) (compute-action-stamp nil o c :just-done t))))
    84888409
    84898410
     
    91249045                                            (action-index status) ;; if already visited, keep index
    91259046                                            (incf (plan-total-action-count plan))))) ; else new index
     9047                          (when (and done-p (not add-to-plan-p))
     9048                            (setf (component-operation-time operation component) stamp))
    91269049                          (when add-to-plan-p ; if it needs to be added to the plan,
    91279050                            (incf (plan-planned-action-count plan)) ; count it
     
    94149337  (defun already-loaded-systems ()
    94159338    "return a list of the names of the systems that have been successfully loaded so far"
    9416     (remove-if-not 'component-loaded-p (registered-systems)))
     9339    (mapcar 'coerce-name (remove-if-not 'component-loaded-p (registered-systems*))))
    94179340
    94189341  (defun require-system (system &rest keys &key &allow-other-keys)
     
    98549777
    98559778  (defparameter *wild-asd*
    9856     (make-pathname* :directory nil :name *wild* :type "asd" :version :newest))
     9779    (make-pathname :directory nil :name *wild* :type "asd" :version :newest))
    98579780
    98589781  (defun directory-asd-files (directory)
     
    98789801      (directory &key (exclude *default-source-registry-exclusions*) collect
    98799802                   (recurse-beyond-asds *recurse-beyond-asds*) ignore-cache)
    9880     (collect-sub*directories
    9881      directory
    9882      #'(lambda (dir)
    9883          (unless (and (not ignore-cache) (process-source-registry-cache directory collect))
    9884            (let ((asds (collect-asds-in-directory dir collect)))
    9885              (or recurse-beyond-asds (not asds)))))
    9886      #'(lambda (x)
    9887          (not (member (car (last (pathname-directory x))) exclude :test #'equal)))
    9888      (constantly nil)))
     9803    (let ((visited (make-hash-table :test 'equalp)))
     9804      (collect-sub*directories
     9805       directory
     9806       #'(lambda (dir)
     9807           (unless (and (not ignore-cache) (process-source-registry-cache directory collect))
     9808             (let ((asds (collect-asds-in-directory dir collect)))
     9809               (or recurse-beyond-asds (not asds)))))
     9810       #'(lambda (x)                    ; x will be a directory pathname
     9811           (and
     9812            (not (member (car (last (pathname-directory x))) exclude :test #'equal))
     9813            (flet ((pathname-key (x)
     9814                     (namestring (truename* x))))
     9815              (let ((visitedp (gethash (pathname-key x) visited)))
     9816                (if visitedp nil
     9817                    (setf (gethash (pathname-key x) visited) t))))))
     9818       (constantly nil))))
    98899819
    98909820  (defun validate-source-registry-directive (directive)
     
    99799909      :inherit-configuration
    99809910      #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:"))
    9981       #+cmu (:tree #p"modules:")
     9911      #+cmucl (:tree #p"modules:")
    99829912      #+scl (:tree #p"file://modules/")))
    99839913  (defun default-user-source-registry ()
     
    1029610226;;; Main parsing function
    1029710227(with-upgradability ()
    10298   (defun* parse-dependency-def (dd)
     10228  (defun parse-dependency-def (dd)
    1029910229    (if (listp dd)
    1030010230        (case (first dd)
     
    1031710247      (coerce-name dd)))
    1031810248
    10319   (defun* parse-dependency-defs (dd-list)
     10249  (defun parse-dependency-defs (dd-list)
    1032010250    "Parse the dependency defs in DD-LIST into canonical form by translating all
    1032110251system names contained using COERCE-NAME. Return the result."
    1032210252    (mapcar 'parse-dependency-def dd-list))
    1032310253
    10324   (defun* (parse-component-form) (parent options &key previous-serial-component)
     10254  (defun (parse-component-form) (parent options &key previous-serial-component)
    1032510255    (destructuring-bind
    1032610256        (type name &rest rest &key
     
    1041210342      (let* ((name (coerce-name name))
    1041310343             (source-file (if sfp source-file (resolve-symlinks* (load-pathname))))
     10344             ;; NB: handle defsystem-depends-on BEFORE to create the system object,
     10345             ;; so that in case it fails, there is no incomplete object polluting the build.
     10346             (checked-defsystem-depends-on
     10347               (let* ((dep-forms (parse-dependency-defs defsystem-depends-on))
     10348                      (deps (loop :for spec :in dep-forms
     10349                                  :when (resolve-dependency-spec nil spec)
     10350                                    :collect :it)))
     10351                 (load-systems* deps)
     10352                 dep-forms))
    1041410353             (registered (system-registered-p name))
    1041510354             (registered! (if registered
     
    1042010359                                   :name name :source-file source-file))
    1042110360             (component-options
    10422               (remove-plist-keys '(:defsystem-depends-on :class) options))
    10423              (defsystem-dependencies (loop :for spec :in defsystem-depends-on
    10424                                            :when (resolve-dependency-spec nil spec)
    10425                                            :collect :it)))
    10426         ;; cache defsystem-depends-on in canonical form
    10427         (when defsystem-depends-on
    10428           (setf component-options
    10429                 (append `(:defsystem-depends-on ,(parse-dependency-defs defsystem-depends-on))
    10430                         component-options)))
     10361              (append
     10362               (remove-plist-keys '(:defsystem-depends-on :class) options)
     10363               ;; cache defsystem-depends-on in canonical form
     10364               (when checked-defsystem-depends-on
     10365                 `(:defsystem-depends-on ,checked-defsystem-depends-on)))))
    1043110366        (set-asdf-cache-entry `(find-system ,name) (list system))
    10432         (load-systems* defsystem-dependencies)
    1043310367        ;; We change-class AFTER we loaded the defsystem-depends-on
    1043410368        ;; since the class might be defined as part of those.
     
    1066810602              (type (bundle-pathname-type bundle-type)))
    1066910603          (values (list (subpathname (component-pathname c) name :type type))
    10670                   (eq (type-of o) (coerce-class (component-build-operation c)
    10671                                                 :package :asdf/interface
    10672                                                 :super 'operation
    10673                                                 :error nil)))))))
     10604                  (eq (class-of o) (coerce-class (component-build-operation c)
     10605                                                 :package :asdf/interface
     10606                                                 :super 'operation
     10607                                                 :error nil)))))))
    1067410608
    1067510609  (defmethod output-files ((o bundle-op) (c system))
     
    1102410958               :no-uiop (no-uiop c)
    1102510959               (when programp `(:entry-point ,(component-entry-point c))))))))
    11026 
    11027 #+(and (not asdf-use-unsafe-mac-bundle-op)
    11028        (or (and clasp ecl darwin)
    11029            (and abcl darwin (not abcl-bundle-op-supported))))
    11030 (defmethod perform :before ((o basic-compile-bundle-op) (c component))
    11031   (unless (featurep :asdf-use-unsafe-mac-bundle-op)
    11032     (cerror "Continue after modifying *FEATURES*."
    11033             "BASIC-COMPILE-BUNDLE-OP operations are not supported on Mac OS X for this lisp.~%~T~
    11034 To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~
    11035 Please report to ASDF-DEVEL if this works for you.")))
    1103610960;;;; -------------------------------------------------------------------------
    1103710961;;;; Concatenate-source
     
    1122011144      (error 'package-inferred-system-missing-package-error :system system :pathname file)))
    1122111145
    11222   (defun same-package-inferred-system-p (system name directory subpath dependencies)
     11146  (defun same-package-inferred-system-p (system name directory subpath around-compile dependencies)
    1122311147    (and (eq (type-of system) 'package-inferred-system)
    1122411148         (equal (component-name system) name)
    1122511149         (pathname-equal directory (component-pathname system))
    1122611150         (equal dependencies (component-sideway-dependencies system))
     11151         (equal around-compile (around-compile-hook system))
    1122711152         (let ((children (component-children system)))
    1122811153           (and (length=n-p children 1)
     
    1124411169                (when (file-pathname-p f)
    1124511170                  (let ((dependencies (package-inferred-system-file-dependencies f system))
    11246                         (previous (cdr (system-registered-p system))))
    11247                     (if (same-package-inferred-system-p previous system dir sub dependencies)
     11171                        (previous (cdr (system-registered-p system)))
     11172                        (around-compile (around-compile-hook top)))
     11173                    (if (same-package-inferred-system-p previous system dir sub around-compile dependencies)
    1124811174                        previous
    1124911175                        (eval `(defsystem ,system
     
    1125211178                                 :pathname ,dir
    1125311179                                 :depends-on ,dependencies
     11180                                 :around-compile ,around-compile
    1125411181                                 :components ((cl-source-file "lisp" :pathname ,sub)))))))))))))))
    1125511182
     
    1126511192  (:recycle :asdf/backward-internals :asdf)
    1126611193  (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system)
    11267   (:export ;; for internal use
    11268    #:make-sub-operation
    11269    #:load-sysdef #:make-temporary-package))
     11194  (:export #:load-sysdef))
    1127011195(in-package :asdf/backward-internals)
    1127111196
    11272 (when-upgrading (:when (fboundp 'make-sub-operation))
    11273   (defun make-sub-operation (c o dep-c dep-o)
    11274     (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
    11275 
    11276 ;;;; load-sysdef
    1127711197(with-upgradability ()
    1127811198  (defun load-sysdef (name pathname)
    11279     (load-asd pathname :name name))
    11280 
    11281   (defun make-temporary-package ()
    11282     ;; For loading a .asd file, we don't make a temporary package anymore,
    11283     ;; but use ASDF-USER. I'd like to have this function do this,
    11284     ;; but since whoever uses it is likely to delete-package the result afterwards,
    11285     ;; this would be a bad idea, so preserve the old behavior.
    11286     (make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf))))
    11287 
     11199    (declare (ignore name pathname))
     11200    ;; Needed for backward compatibility with swank-asdf from SLIME 2015-12-01 or older.
     11201    (error "Use asdf:load-asd instead of asdf::load-sysdef")))
    1128811202;;;; -------------------------------------------------------------------------
    1128911203;;; Backward-compatible interfaces
     
    1165511569
    1165611570;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
    11657 #+(or abcl clasp clisp clozure cmu ecl mkcl sbcl)
     11571#+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl)
    1165811572(with-upgradability ()
    1165911573  (if-let (x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom nil)))
    1166011574    (eval `(pushnew 'module-provide-asdf
    1166111575                    #+abcl sys::*module-provider-functions*
    11662                     #+(or clasp cmu ecl) ext:*module-provider-functions*
     11576                    #+(or clasp cmucl ecl) ext:*module-provider-functions*
    1166311577                    #+clisp ,x
    1166411578                    #+clozure ccl:*module-provider-functions*
     
    1168411598                          (values-list l))))))))
    1168511599
    11686 #+cmu ;; Hook into the CMUCL herald.
     11600#+cmucl ;; Hook into the CMUCL herald.
    1168711601(with-upgradability ()
    1168811602  (defun herald-asdf (stream)
     
    1169511609  #+allegro
    1169611610  (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
    11697     (setf excl:*warn-on-nested-reader-conditionals* asdf/common-lisp::*acl-warn-save*))
     11611    (setf excl:*warn-on-nested-reader-conditionals* uiop/common-lisp::*acl-warn-save*))
    1169811612
    1169911613  (dolist (f '(:asdf :asdf2 :asdf3 :asdf3.1 :asdf-package-system)) (pushnew f *features*))
Note: See TracChangeset for help on using the changeset viewer.