Changeset 13922


Ignore:
Timestamp:
04/30/12 07:47:19 (9 years ago)
Author:
Mark Evenson
Message:

asdf: update to asdf-2.21

Location:
trunk/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/doc/asdf/asdf.texinfo

    r13911 r13922  
    3636@url{http://common-lisp.net/project/asdf/asdf.html}.
    3737
    38 ASDF Copyright @copyright{} 2001-2011 Daniel Barlow and contributors.
    39 
    40 This manual Copyright @copyright{} 2001-2011 Daniel Barlow and contributors.
    41 
    42 This manual revised @copyright{} 2009-2011 Robert P. Goldman and Francois-Rene Rideau.
     38ASDF Copyright @copyright{} 2001-2012 Daniel Barlow and contributors.
     39
     40This manual Copyright @copyright{} 2001-2012 Daniel Barlow and contributors.
     41
     42This manual revised @copyright{} 2009-2012 Robert P. Goldman and Francois-Rene Rideau.
    4343
    4444Permission is hereby granted, free of charge, to any person obtaining
     
    198198@cindex link farm
    199199@findex load-system
     200@findex require-system
    200201@findex compile-system
    201202@findex test-system
     
    220221As of the writing of this manual,
    221222the following implementations provide ASDF 2 this way:
    222 abcl allegro ccl clisp cmucl ecl sbcl xcl.
    223 The following implementations don't provide it yet but will in a future release:
    224 lispworks scl.
    225 The following implementations are obsolete and most probably will never bundle it:
     223abcl allegro ccl clisp cmucl ecl lispworks sbcl xcl.
     224The following implementation doesn't provide it yet but will in a future release:
     225scl.
     226The following implementations are obsolete, not actively maintained,
     227and most probably will never bundle it:
    226228cormancl gcl genera mcl.
    227229
     
    668670ASDF provides three commands for the most common system operations:
    669671@code{load-system}, @code{compile-system} or @code{test-system}.
     672It also provides @code{require-system}, a version of @code{load-system}
     673that skips trying to update systems that are already loaded.
    670674
    671675Because ASDF is an extensible system
     
    20822086             ;; In output translations, if last component, **/*.*.* is added
    20832087    PATHNAME | ;; pathname; unless last component, directory is assumed.
    2084     :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.49-linux-x64
     2088    :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.45-linux-x64
    20852089    :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl
    20862090    :DEFAULT-DIRECTORY | ;; a relativized version of the default directory
     
    29052909etc.
    29062910
     2911Note that there is no around-load hook. This is on purpose.
     2912Some implementations such as ECL or GCL link object files,
     2913which allows for no such hook.
     2914Other implementations allow for concatenating FASL files,
     2915which doesn't allow for such a hook either.
     2916We aim to discourage something that's not portable,
     2917and has some dubious impact on performance and semantics
     2918even when it is possible.
     2919Things you might want to do with an around-load hook
     2920are better done around-compile,
     2921though it may at times require some creativity
     2922(see e.g. the @code{package-renaming} system).
     2923
     2924
     2925@section Controlling source file character encoding
     2926
     2927Starting with ASDF 2.21, components accept a @code{:encoding} option.
     2928By default, only @code{:default}, @code{:utf-8}
     2929and @code{:autodetect} are accepted.
     2930@code{:autodetect} is the default, and calls
     2931@code{*encoding-detection-hook*} which by default always returns
     2932@code{*default-encoding*} which itself defaults to @code{:default}.
     2933In other words, there now are plenty of extension hooks, but
     2934by default ASDF follows the backwards compatible behavior
     2935of using whichever @code{:default} encoding your implementation uses,
     2936which itself may or may not vary based on environment variables
     2937and other locale settings.
     2938In practice this means that only source code that only uses ASCII
     2939is guaranteed to be read the same on all implementations
     2940independently from any user setting.
     2941
     2942Additionally, for backward-compatibility with older versions of ASDF
     2943and/or with implementations that do not support unicode and its many encodings,
     2944you may want to use
     2945the reader conditionals @code{#+asdf-unicode #+asdf-unicode}
     2946to protect any @code{:encoding @emph{encoding}} statement
     2947as @code{:asdf-unicode} will be present in @code{*features*}
     2948only if you're using a recent ASDF
     2949on an implementation that supports unicode.
     2950We recommend that you avoid using unprotected @code{:encoding} specifications
     2951until after ASDF 2.21 becomes widespread, hopefully by the end of 2012.
     2952
     2953While it offers plenty of hooks for extension,
     2954and one such extension is being developed (see below),
     2955ASDF itself only recognizes one encoding beside @code{:default},
     2956and that is @code{:utf-8}, which is the @emph{de facto} standard,
     2957already used by the vast majority of libraries that use more than ASCII.
     2958On implementations that do not support unicode,
     2959the feature @code{:asdf-unicode} is absent, and
     2960the @code{:default} external-format is used
     2961to read even source files declared as @code{:utf-8}.
     2962On these implementations, non-ASCII characters
     2963intended to be read as one CL character
     2964may thus end up being read as multiple CL characters.
     2965In most cases, this shouldn't affect the software's semantics:
     2966comments will be skipped just the same, strings with be read and printed
     2967with slightly different lengths, symbol names will be accordingly longer,
     2968but none of it should matter.
     2969But a few systems that actually depend on unicode characters
     2970may fail to work properly, or may work in a subtly different way.
     2971See for instance @code{lambda-reader}.
     2972
     2973We invite you to embrace UTF-8
     2974as the encoding for non-ASCII characters starting today,
     2975even without any explicit specification in your @code{.asd} files.
     2976Indeed, on some implementations and configurations,
     2977UTF-8 is already the @code{:default},
     2978and loading your code may cause errors if it is encoded in anything but UTF-8.
     2979Therefore, even with the legacy behavior,
     2980non-UTF-8 is guaranteed to break for some users,
     2981whereas UTF-8 is pretty much guaranteed not to break anywhere
     2982(provided you do @emph{not} use a BOM),
     2983although it might be read incorrectly on some implementations.
     2984In the future, we intend to make @code{:utf-8}
     2985the default value of @code{*default-encoding*},
     2986to be enforced everywhere, so at least the code is guaranteed
     2987to be read correctly everywhere it can be.
     2988
     2989If you need non-standard character encodings for your source code,
     2990use the extension system @code{asdf-encodings}, by specifying
     2991@code{:defsystem-depends-on (:asdf-encodings)} in your @code{defsystem}.
     2992This extension system will register support for more encodings using the
     2993@code{*encoding-external-format-hook*} facility,
     2994so you can explicitly specify @code{:encoding :latin1}
     2995in your @code{.asd} file.
     2996Using the @code{*encoding-detection-hook*} it will also
     2997eventually implement some autodetection of a file's encoding
     2998from an emacs-style @code{-*- mode: lisp ; coding: latin1 -*-} declaration,
     2999or otherwise based on an analysis of octet patterns in the file.
     3000At this point, asdf-encoding only supports the encodings
     3001that are supported as part of your implementation.
     3002Since the list varies depending on implementations,
     3003we once again recommend you use @code{:utf-8} everywhere,
     3004which is the most portable (next is @code{:latin1}).
     3005
     3006If you're not using a version of Quicklisp that has it,
     3007you may get the source for @code{asdf-encodings} using git:
     3008@kbd{git clone git://common-lisp.net/projects/asdf/asdf-encodings.git}
     3009or
     3010@kbd{git clone ssh://common-lisp.net/project/asdf/git/asdf-encodings.git}.
     3011You can also browse the repository on
     3012@url{http://common-lisp.net/gitweb?p=projects/asdf/asdf-encodings.git}.
     3013
     3014In the future, we intend to change the default @code{*default-encoding*}
     3015to @code{:utf-8}, which is already the de facto standard
     3016for most libraries that use non-ASCII characters:
     3017utf-8 works everywhere and was backhandedly enforced by
     3018a lot of people using SBCL and utf-8 and sending reports to authors
     3019so they make their packages compatible.
     3020A survey showed only about a handful few libraries
     3021are incompatible with non-UTF-8, and then, only in comments,
     3022and we believe that authors will adopt UTF-8 when prompted.
     3023See the April 2012 discussion on the asdf-devel mailing-list.
     3024For backwards compatibility with users who insist on a non-UTF-8 encoding,
     3025but cannot immediately transition to using @code{asdf-encodings}
     3026(maybe because it isn't ready), it will still be possible to use
     3027the @code{:encoding :default} option in your @code{defsystem} form
     3028to restore the behavior of ASDF 2.20 and earlier.
     3029This shouldn't be required in libraries,
     3030because user pressure as mentioned above will already have pushed
     3031library authors towards using UTF-8;
     3032but authors of end-user programs might care.
     3033
     3034When you use @code{asdf-encodings}, any further loaded @code{.asd} file
     3035will use the autodetection algorithm to determine its encoding;
     3036yet if you depend on this detection happening,
     3037you may want to explicitly load @code{asdf-encodings} early in your build,
     3038for by the time you can use @code{:defsystem-depends-on},
     3039it is already too late to load it.
     3040In practice, this means that the @code{*default-encoding*}
     3041is usually used for @code{.asd} files.
     3042Currently, this defaults to @code{:default} for backwards compatibility,
     3043and that means that you shouldn't rely on non-ASCII characters in a .asd file.
     3044Since component (path)names are the only real data in these files,
     3045and non-ASCII characters are not very portable for file names,
     3046this isn't too much of an issue.
     3047We still encourage you to use either plain ASCII or UTF-8
     3048in @code{.asd} files,
     3049as we intend to make @code{:utf-8} the default encoding in the future.
     3050This might matter, for instance, in meta-data about author's names.
     3051
    29073052
    29083053@section Miscellaneous Exported Functions
     
    30063151``If it's not backwards, it's not compatible''. We strongly discourage its use.
    30073152Its current behavior is only well-defined on Unix platforms
    3008 (which includes MacOS X and cygwin). On Windows, anything goes.
     3153(which include MacOS X and cygwin). On Windows, anything goes.
    30093154
    30103155Instead we recommend the use of such a function as
    3011 @code{xcvb-driver:run-program/process-output-stream}
     3156@code{xcvb-driver:run-program/}
    30123157from the @code{xcvb-driver} system that is distributed with XCVB:
    30133158@url{http://common-lisp.net/project/xcvb}.
     
    30183163@code{run-shell-command} doesn't make sense anyway on that platform).
    30193164
    3020 This function takes as arguments a @code{format} control-string
     3165@code{run-shell-command} takes as arguments a @code{format} control-string
    30213166and arguments to be passed to @code{format} after this control-string
    30223167to produce a string.
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r13911 r13922  
    1 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
    2 ;;; This is ASDF 2.20: Another System Definition Facility.
     1;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
     2;;; This is ASDF 2.21: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    2020;;;  Monday; July 13, 2009)
    2121;;;
    22 ;;; Copyright (c) 2001-2011 Daniel Barlow and contributors
     22;;; Copyright (c) 2001-2012 Daniel Barlow and contributors
    2323;;;
    2424;;; Permission is hereby granted, free of charge, to any person obtaining
     
    4848#+xcvb (module ())
    4949
    50 (cl:in-package #-genera :common-lisp-user #+genera :future-common-lisp-user)
     50(cl:in-package :common-lisp-user)
     51#+genera (in-package :future-common-lisp-user)
    5152
    5253#-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl sbcl scl xcl)
    5354(error "ASDF is not supported on your implementation. Please help us port it.")
    5455
     56;;;; Create and setup packages in a way that is compatible with hot-upgrade.
     57;;;; See https://bugs.launchpad.net/asdf/+bug/485687
     58;;;; See these two eval-when forms, and more near the end of the file.
     59
    5560#+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this
    5661
    57 (eval-when (:compile-toplevel :load-toplevel :execute)
    58   ;;; Implementation-dependent tweaks
     62(eval-when (:load-toplevel :compile-toplevel :execute)
     63  ;;; Before we do anything, some implementation-dependent tweaks
    5964  ;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; NO: trust implementation defaults.
    6065  #+allegro
     
    6267        (remove "asdf" excl::*autoload-package-name-alist*
    6368                :test 'equalp :key 'car)) ; need that BEFORE any mention of package ASDF as below
    64   #+ecl (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t))
    65   #+ecl (unless (use-ecl-byte-compiler-p) (require :cmp))
    6669  #+gcl ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011
    6770  (when (or (< system::*gcl-major-version* 2) ;; GCL 2.6 fails to fully compile ASDF at all
     
    6972                 (< system::*gcl-minor-version* 7)))
    7073    (pushnew :gcl-pre2.7 *features*))
     74  #+(or abcl (and allegro ics) (and clisp unicode) clozure (and cmu unicode)
     75        (and ecl unicode) lispworks (and sbcl sb-unicode) scl)
     76  (pushnew :asdf-unicode *features*)
    7177  ;;; make package if it doesn't exist yet.
    7278  ;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it.
     
    7682(in-package :asdf)
    7783
    78 ;;;; Create packages in a way that is compatible with hot-upgrade.
    79 ;;;; See https://bugs.launchpad.net/asdf/+bug/485687
    80 ;;;; See more near the end of the file.
    81 
    8284(eval-when (:load-toplevel :compile-toplevel :execute)
     85  ;;; This would belong amongst implementation-dependent tweaks above,
     86  ;;; except that the defun has to be in package asdf.
     87  #+ecl (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t))
     88  #+ecl (unless (use-ecl-byte-compiler-p) (require :cmp))
     89
     90  ;;; Package setup, step 2.
    8391  (defvar *asdf-version* nil)
    8492  (defvar *upgraded-p* nil)
     
    109117         ;; "2.345.0.7" would be your seventh local modification of official release 2.345
    110118         ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
    111          (asdf-version "2.20")
     119         (asdf-version "2.21")
    112120         (existing-asdf (find-class 'component nil))
    113121         (existing-version *asdf-version*)
     
    169177             (shadow symbols package))
    170178           (ensure-use (package use)
     179             (dolist (used (package-use-list package))
     180               (unless (member (package-name used) use :test 'string=)
     181                 (unuse-package used)
     182                 (do-external-symbols (sym used)
     183                   (when (eq sym (find-symbol* sym package))
     184                     (remove-symbol sym package)))))
    171185             (dolist (used (reverse use))
    172186               (do-external-symbols (sym used)
     
    200214                                 shadow export redefined-functions)
    201215             (let* ((p (ensure-exists name nicknames use)))
    202                (ensure-unintern p unintern)
     216               (ensure-unintern p (append unintern #+cmu redefined-functions))
    203217               (ensure-shadow p shadow)
    204218               (ensure-export p export)
    205                (ensure-fmakunbound p redefined-functions)
     219               #-cmu (ensure-fmakunbound p redefined-functions)
    206220               p)))
    207221        (macrolet
     
    235249            #:system-definition-pathname #:with-system-definitions
    236250            #:search-for-system-definition #:find-component #:component-find-path
    237             #:compile-system #:load-system #:load-systems #:test-system #:clear-system
     251            #:compile-system #:load-system #:load-systems
     252            #:require-system #:test-system #:clear-system
    238253            #:operation #:compile-op #:load-op #:load-source-op #:test-op
    239254            #:feature #:version #:version-satisfies
    240255            #:upgrade-asdf
    241             #:implementation-identifier #:implementation-type
     256            #:implementation-identifier #:implementation-type #:hostname
    242257            #:input-files #:output-files #:output-file #:perform
    243258            #:operation-done-p #:explain
     
    256271
    257272            #:module-components          ; component accessors
    258             #:module-components-by-name  ; component accessors
     273            #:module-components-by-name
    259274            #:component-pathname
    260275            #:component-relative-pathname
     
    264279            #:component-property
    265280            #:component-system
    266 
    267281            #:component-depends-on
     282            #:component-encoding
     283            #:component-external-format
    268284
    269285            #:system-description
     
    282298            #:operation-on-failure
    283299            #:component-visited-p
    284             ;;#:*component-parent-pathname*
    285             #:*system-definition-search-functions*
    286             #:*central-registry*         ; variables
     300
     301            #:*system-definition-search-functions*   ; variables
     302            #:*central-registry*
    287303            #:*compile-file-warnings-behaviour*
    288304            #:*compile-file-failure-behaviour*
     
    312328            #:coerce-entry-to-directory
    313329            #:remove-entry-from-registry
     330
     331            #:*encoding-detection-hook*
     332            #:*encoding-external-format-hook*
     333            #:*default-encoding*
     334            #:*utf-8-external-format*
    314335
    315336            #:clear-configuration
     
    330351            #:ensure-source-registry
    331352            #:process-source-registry
    332             #:system-registered-p
     353            #:system-registered-p #:registered-systems #:loaded-systems
     354            #:resolve-location
    333355            #:asdf-message
    334356            #:user-output-translations-pathname
     
    342364
    343365            ;; Utilities
    344             #:absolute-pathname-p
    345366            ;; #:aif #:it
    346             ;; #:appendf #:orf
     367            #:appendf #:orf
     368            #:length=n-p
     369            #:remove-keys #:remove-keyword
     370            #:first-char #:last-char #:ends-with
    347371            #:coerce-name
    348             #:directory-pathname-p
    349             ;; #:ends-with
    350             #:ensure-directory-pathname
     372            #:directory-pathname-p #:ensure-directory-pathname
     373            #:absolute-pathname-p #:ensure-pathname-absolute #:pathname-root
    351374            #:getenv
    352             ;; #:length=n-p
    353             ;; #:find-symbol*
    354             #:merge-pathnames* #:coerce-pathname #:subpathname
    355             #:pathname-directory-pathname
     375            #:probe-file*
     376            #:find-symbol* #:strcat
     377            #:make-pathname-component-logical #:make-pathname-logical
     378            #:merge-pathnames* #:coerce-pathname #:subpathname #:subpathname*
     379            #:pathname-directory-pathname #:pathname-parent-directory-pathname
    356380            #:read-file-forms
    357             ;; #:remove-keys
    358             ;; #:remove-keyword
    359             #:resolve-symlinks
     381            #:resolve-symlinks #:truenamize
    360382            #:split-string
    361383            #:component-name-to-pathname-components
    362384            #:split-name-type
    363             #:subdirectories
    364             #:truenamize
    365             #:while-collecting)))
     385            #:subdirectories #:directory-files
     386            #:while-collecting
     387            #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors*
     388            #:*wild-path* #:wilden
     389            #:directorize-pathname-host-device
     390            )))
    366391        #+genera (import 'scl:boolean :asdf)
    367392        (setf *asdf-version* asdf-version
     
    482507
    483508(defmacro aif (test then &optional else)
     509  "Anaphoric version of IF, On Lisp style"
    484510  `(let ((it ,test)) (if it ,then ,else)))
    485511
     
    491517
    492518(defun* normalize-pathname-directory-component (directory)
     519  "Given a pathname directory component, return an equivalent form that is a list"
    493520  (cond
    494     #-(or cmu sbcl scl)
     521    #-(or cmu sbcl scl) ;; these implementations already normalize directory components.
    495522    ((stringp directory) `(:absolute ,directory) directory)
    496523    #+gcl
     
    504531
    505532(defun* merge-pathname-directory-components (specified defaults)
     533  ;; Helper for merge-pathnames* that handles directory components.
    506534  (let ((directory (normalize-pathname-directory-component specified)))
    507535    (ecase (first directory)
     
    525553              :finally (return (cons defabs (append (reverse defrev) reldir)))))))))))
    526554
    527 (defun* ununspecific (x)
    528   (if (eq x :unspecific) nil x))
     555(defun* make-pathname-component-logical (x)
     556  "Make a pathname component suitable for use in a logical-pathname"
     557  (typecase x
     558    ((eql :unspecific) nil)
     559    #+clisp (string (string-upcase x))
     560    #+clisp (cons (mapcar 'make-pathname-component-logical x))
     561    (t x)))
     562
     563(defun* make-pathname-logical (pathname host)
     564  "Take a PATHNAME's directory, name, type and version components,
     565and make a new pathname with corresponding components and specified logical HOST"
     566  (make-pathname
     567   :host host
     568   :directory (make-pathname-component-logical (pathname-directory pathname))
     569   :name (make-pathname-component-logical (pathname-name pathname))
     570   :type (make-pathname-component-logical (pathname-type pathname))
     571   :version (make-pathname-component-logical (pathname-version pathname))))
    529572
    530573(defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*))
     
    547590         (version (or (pathname-version specified) (pathname-version defaults))))
    548591    (labels ((unspecific-handler (p)
    549                (if (typep p 'logical-pathname) #'ununspecific #'identity)))
     592               (if (typep p 'logical-pathname) #'make-pathname-component-logical #'identity)))
    550593      (multiple-value-bind (host device directory unspecific-handler)
    551594          (ecase (first directory)
     
    615658         ;; Giving :unspecific as argument to make-pathname is not portable.
    616659         ;; See CLHS make-pathname and 19.2.2.2.3.
    617          ;; We only use it on implementations that support it.
    618          (or #+(or clozure gcl lispworks sbcl) :unspecific)))
     660         ;; We only use it on implementations that support it,
     661         #+(or abcl allegro clozure cmu gcl genera lispworks sbcl scl xcl) :unspecific
     662         #+(or clisp ecl #|These haven't been tested:|# cormanlisp mcl) nil))
    619663    (destructuring-bind (name &optional (type unspecific))
    620664        (split-string filename :max 2 :separator ".")
     
    745789  (and (typep pathspec '(or pathname string))
    746790       (eq :absolute (car (pathname-directory (pathname pathspec))))))
     791
     792(defun* coerce-pathname (name &key type defaults)
     793  "coerce NAME into a PATHNAME.
     794When given a string, portably decompose it into a relative pathname:
     795#\\/ separates subdirectories. The last #\\/-separated string is as follows:
     796if TYPE is NIL, its last #\\. if any separates name and type from from type;
     797if TYPE is a string, it is the type, and the whole string is the name;
     798if TYPE is :DIRECTORY, the string is a directory component;
     799if the string is empty, it's a directory.
     800Any directory named .. is read as :BACK.
     801Host, device and version components are taken from DEFAULTS."
     802  ;; The defaults are required notably because they provide the default host
     803  ;; to the below make-pathname, which may crucially matter to people using
     804  ;; merge-pathnames with non-default hosts,  e.g. for logical-pathnames.
     805  ;; NOTE that the host and device slots will be taken from the defaults,
     806  ;; but that should only matter if you later merge relative pathnames with
     807  ;; CL:MERGE-PATHNAMES instead of ASDF:MERGE-PATHNAMES*
     808  (etypecase name
     809    ((or null pathname)
     810     name)
     811    (symbol
     812     (coerce-pathname (string-downcase name) :type type :defaults defaults))
     813    (string
     814     (multiple-value-bind (relative path filename)
     815         (component-name-to-pathname-components name :force-directory (eq type :directory)
     816                                                :force-relative t)
     817       (multiple-value-bind (name type)
     818           (cond
     819             ((or (eq type :directory) (null filename))
     820              (values nil nil))
     821             (type
     822              (values filename type))
     823             (t
     824              (split-name-type filename)))
     825         (apply 'make-pathname :directory (cons relative path) :name name :type type
     826                (when defaults `(:defaults ,defaults))))))))
     827
     828(defun* merge-component-name-type (name &key type defaults)
     829  ;; For backwards compatibility only, for people using internals.
     830  ;; Will be removed in a future release, e.g. 2.016.
     831  (warn "Please don't use ASDF::MERGE-COMPONENT-NAME-TYPE. Use ASDF:COERCE-PATHNAME.")
     832  (coerce-pathname name :type type :defaults defaults))
     833
     834(defun* subpathname (pathname subpath &key type)
     835  (and pathname (merge-pathnames* (coerce-pathname subpath :type type)
     836                                  (pathname-directory-pathname pathname))))
     837
     838(defun subpathname* (pathname subpath &key type)
     839  (and pathname
     840       (subpathname (ensure-directory-pathname pathname) subpath :type type)))
    747841
    748842(defun* length=n-p (x n) ;is it that (= (length x) n) ?
     
    897991        (port (ext:pathname-port pathname))
    898992        (directory (pathname-directory pathname)))
    899     (if (or (ununspecific port)
    900             (and (ununspecific host) (plusp (length host)))
    901             (ununspecific scheme))
     993    (flet ((specificp (x) (and x (not (eq x :unspecific)))))
     994      (if (or (specificp port)
     995              (and (specificp host) (plusp (length host)))
     996              (specificp scheme))
    902997        (let ((prefix ""))
    903           (when (ununspecific port)
     998          (when (specificp port)
    904999            (setf prefix (format nil ":~D" port)))
    905           (when (and (ununspecific host) (plusp (length host)))
     1000          (when (and (specificp host) (plusp (length host)))
    9061001            (setf prefix (strcat host prefix)))
    9071002          (setf prefix (strcat ":" prefix))
    908           (when (ununspecific scheme)
     1003          (when (specificp scheme)
    9091004            (setf prefix (strcat scheme prefix)))
    9101005          (assert (and directory (eq (first directory) :absolute)))
    9111006          (make-pathname :directory `(:absolute ,prefix ,@(rest directory))
    9121007                         :defaults pathname)))
    913     pathname))
     1008    pathname)))
    9141009
    9151010;;;; -------------------------------------------------------------------------
     
    9491044(defgeneric* (setf component-property) (new-value component property))
    9501045
     1046(defgeneric* component-external-format (component))
     1047
     1048(defgeneric* component-encoding (component))
     1049
    9511050(eval-when (#-gcl :compile-toplevel :load-toplevel :execute)
    9521051  (defgeneric* (setf module-components-by-name) (new-value module)))
     
    10261125;;; Methods in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
    10271126(when *upgraded-p*
    1028    (when (find-class 'module nil)
    1029      (eval
    1030       '(defmethod update-instance-for-redefined-class :after
    1031            ((m module) added deleted plist &key)
    1032          (declare (ignorable deleted plist))
    1033          (when *asdf-verbose*
    1034            (asdf-message (compatfmt "~&~@<; ~@;Updating ~A for ASDF ~A~@:>~%")
    1035                          m (asdf-version)))
    1036          (when (member 'components-by-name added)
    1037            (compute-module-components-by-name m))
    1038          (when (typep m 'system)
    1039            (when (member 'source-file added)
    1040              (%set-system-source-file
    1041               (probe-asd (component-name m) (component-pathname m)) m)
    1042              (when (equal (component-name m) "asdf")
    1043                (setf (component-version m) *asdf-version*))))))))
     1127  (when (find-class 'module nil)
     1128    (eval
     1129     '(defmethod update-instance-for-redefined-class :after
     1130          ((m module) added deleted plist &key)
     1131        (declare (ignorable deleted plist))
     1132        (when *asdf-verbose*
     1133          (asdf-message (compatfmt "~&~@<; ~@;Updating ~A for ASDF ~A~@:>~%")
     1134                        m (asdf-version)))
     1135        (when (member 'components-by-name added)
     1136          (compute-module-components-by-name m))
     1137        (when (typep m 'system)
     1138          (when (member 'source-file added)
     1139            (%set-system-source-file
     1140             (probe-asd (component-name m) (component-pathname m)) m)
     1141           (when (equal (component-name m) "asdf")
     1142             (setf (component-version m) *asdf-version*))))))))
    10441143
    10451144;;;; -------------------------------------------------------------------------
     
    11511250   ;; hasn't yet been loaded in the current image (do-first).
    11521251   ;; The names are crap, but they have been the official API since Dan Barlow's ASDF 1.52!
     1252   ;; LispWorks's defsystem has caused-by and requires for in-order-to and do-first respectively.
     1253   ;; Maybe rename the slots in ASDF? But that's not very backwards compatible.
    11531254   ;; See our ASDF 2 paper for more complete explanations.
    11541255   (in-order-to :initform nil :initarg :in-order-to
     
    11691270                    :accessor component-operation-times)
    11701271   (around-compile :initarg :around-compile)
     1272   (%encoding :accessor %component-encoding :initform nil :initarg :encoding)
    11711273   ;; XXX we should provide some atomic interface for updating the
    11721274   ;; component properties
     
    12781380              (acons property new-value (slot-value c 'properties)))))
    12791381  new-value)
     1382
     1383(defvar *default-encoding* :default
     1384  "Default encoding for source files.
     1385The default value :default preserves the legacy behavior.
     1386A future default might be :utf-8 or :autodetect
     1387reading emacs-style -*- coding: utf-8 -*- specifications,
     1388and falling back to utf-8 or latin1 if nothing is specified.")
     1389
     1390(defparameter *utf-8-external-format*
     1391  #+(and asdf-unicode (not clisp)) :utf-8
     1392  #+(and asdf-unicode clisp) charset:utf-8
     1393  #-asdf-unicode :default
     1394  "Default :external-format argument to pass to CL:OPEN and also
     1395CL:LOAD or CL:COMPILE-FILE to best process a UTF-8 encoded file.
     1396On modern implementations, this will decode UTF-8 code points as CL characters.
     1397On legacy implementations, it may fall back on some 8-bit encoding,
     1398with non-ASCII code points being read as several CL characters;
     1399hopefully, if done consistently, that won't affect program behavior too much.")
     1400
     1401(defun* always-default-encoding (pathname)
     1402  (declare (ignore pathname))
     1403  *default-encoding*)
     1404
     1405(defvar *encoding-detection-hook* #'always-default-encoding
     1406  "Hook for an extension to define a function to automatically detect a file's encoding")
     1407
     1408(defun* detect-encoding (pathname)
     1409  (funcall *encoding-detection-hook* pathname))
     1410
     1411(defmethod component-encoding ((c component))
     1412  (or (loop :for x = c :then (component-parent x)
     1413        :while x :thereis (%component-encoding x))
     1414      (detect-encoding (component-pathname c))))
     1415
     1416(defun* default-encoding-external-format (encoding)
     1417  (case encoding
     1418    (:default :default) ;; for backwards compatibility only. Explicit usage discouraged.
     1419    (:utf-8 *utf-8-external-format*)
     1420    (otherwise
     1421     (cerror "Continue using :external-format :default" (compatfmt "~@<Your ASDF component is using encoding ~S but it isn't recognized. Your system should :defsystem-depends-on (:asdf-encodings).~:>") encoding)
     1422     :default)))
     1423
     1424(defvar *encoding-external-format-hook*
     1425  #'default-encoding-external-format
     1426  "Hook for an extension to define a mapping between non-default encodings
     1427and implementation-defined external-format's")
     1428
     1429(defun encoding-external-format (encoding)
     1430  (funcall *encoding-external-format-hook* encoding))
     1431
     1432(defmethod component-external-format ((c component))
     1433  (encoding-external-format (component-encoding c)))
    12801434
    12811435(defclass proto-system () ; slots to keep when resetting a system
     
    14421596  (gethash (coerce-name name) *defined-systems*))
    14431597
     1598(defun* registered-systems ()
     1599  (loop :for (() . system) :being :the :hash-values :of *defined-systems*
     1600    :collect (coerce-name system)))
     1601
    14441602(defun* register-system (system)
    14451603  (check-type system system)
     
    15321690  (block nil
    15331691    (when (directory-pathname-p defaults)
    1534       (let ((file (make-pathname
    1535                    :defaults defaults :name name
    1536                    :version :newest :case :local :type "asd")))
    1537         (when (probe-file* file)
     1692      (let* ((file (probe-file* (subpathname defaults (strcat name ".asd")))))
     1693        (when file
    15381694          (return file)))
    15391695      #-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!)
     
    16511807             (let ((*package* package)
    16521808                   (*default-pathname-defaults*
    1653                     (pathname-directory-pathname pathname)))
     1809                    ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings.
     1810                    (pathname-directory-pathname (translate-logical-pathname pathname)))
     1811                   (external-format (encoding-external-format (detect-encoding pathname))))
    16541812               (asdf-message (compatfmt "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%")
    16551813                             pathname package)
    1656                (load pathname)))
     1814               (load pathname :external-format external-format)))
    16571815        (delete-package package)))))
    16581816
    16591817(defun* locate-system (name)
    16601818  "Given a system NAME designator, try to locate where to load the system from.
    1661 Returns four values: FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME
    1662 FOUNDP is true when a new was found, either a new unregistered one or a previously registered one.
     1819Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME
     1820FOUNDP is true when a system was found,
     1821either a new unregistered one or a previously registered one.
    16631822FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed as is
    1664 PATHNAME when not null is a path from where to load the system, associated with FOUND-SYSTEM, or with the PREVIOUS system.
     1823PATHNAME when not null is a path from where to load the system,
     1824either associated with FOUND-SYSTEM, or with the PREVIOUS system.
    16651825PREVIOUS when not null is a previously loaded SYSTEM object of same name.
    16661826PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded."
     
    16701830         (previous (and (typep previous 'system) previous))
    16711831         (previous-time (car in-memory))
    1672            (found (search-for-system-definition name))
     1832         (found (search-for-system-definition name))
    16731833         (found-system (and (typep found 'system) found))
    16741834         (pathname (or (and (typep found '(or pathname string)) (pathname found))
     
    17161876        (reinitialize-source-registry-and-retry ()
    17171877          :report (lambda (s)
    1718                     (format s "~@<Retry finding system ~A after reinitializing the source-registry.~@:>" name))
     1878                    (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name))
    17191879          (initialize-source-registry))))))
    17201880
     
    17901950  (source-file-explicit-type component))
    17911951
    1792 (defun* coerce-pathname (name &key type defaults)
    1793   "coerce NAME into a PATHNAME.
    1794 When given a string, portably decompose it into a relative pathname:
    1795 #\\/ separates subdirectories. The last #\\/-separated string is as follows:
    1796 if TYPE is NIL, its last #\\. if any separates name and type from from type;
    1797 if TYPE is a string, it is the type, and the whole string is the name;
    1798 if TYPE is :DIRECTORY, the string is a directory component;
    1799 if the string is empty, it's a directory.
    1800 Any directory named .. is read as :BACK.
    1801 Host, device and version components are taken from DEFAULTS."
    1802   ;; The defaults are required notably because they provide the default host
    1803   ;; to the below make-pathname, which may crucially matter to people using
    1804   ;; merge-pathnames with non-default hosts,  e.g. for logical-pathnames.
    1805   ;; NOTE that the host and device slots will be taken from the defaults,
    1806   ;; but that should only matter if you later merge relative pathnames with
    1807   ;; CL:MERGE-PATHNAMES instead of ASDF:MERGE-PATHNAMES*
    1808   (etypecase name
    1809     ((or null pathname)
    1810      name)
    1811     (symbol
    1812      (coerce-pathname (string-downcase name) :type type :defaults defaults))
    1813     (string
    1814      (multiple-value-bind (relative path filename)
    1815          (component-name-to-pathname-components name :force-directory (eq type :directory)
    1816                                                 :force-relative t)
    1817        (multiple-value-bind (name type)
    1818            (cond
    1819              ((or (eq type :directory) (null filename))
    1820               (values nil nil))
    1821              (type
    1822               (values filename type))
    1823              (t
    1824               (split-name-type filename)))
    1825          (apply 'make-pathname :directory (cons relative path) :name name :type type
    1826                 (when defaults `(:defaults ,defaults))))))))
    1827 
    1828 (defun* merge-component-name-type (name &key type defaults)
    1829   ;; For backwards compatibility only, for people using internals.
    1830   ;; Will be removed in a future release, e.g. 2.016.
    1831   (warn "Please don't use ASDF::MERGE-COMPONENT-NAME-TYPE. Use ASDF:COERCE-PATHNAME.")
    1832   (coerce-pathname name :type type :defaults defaults))
    1833 
    18341952(defmethod component-relative-pathname ((component component))
    18351953  (coerce-pathname
     
    18381956   :type (source-file-type component (component-system component))
    18391957   :defaults (component-parent-pathname component)))
    1840 
    1841 (defun* subpathname (pathname subpath &key type)
    1842   (and pathname (merge-pathnames* (coerce-pathname subpath :type type)
    1843                                   (pathname-directory-pathname pathname))))
    1844 
    1845 (defun subpathname* (pathname subpath &key type)
    1846   (and pathname
    1847        (subpathname (ensure-directory-pathname pathname) subpath :type type)))
    18481958
    18491959;;;; -------------------------------------------------------------------------
     
    18621972   ;; However, but this feature has only ever worked but starting with ASDF 2.014.5
    18631973   (forced :initform nil :initarg :force :accessor operation-forced)
     1974   (forced-not :initform nil :initarg :force-not :accessor operation-forced-not)
    18641975   (original-initargs :initform nil :initarg :original-initargs
    18651976                      :accessor operation-original-initargs)
     
    18741985
    18751986(defmethod shared-initialize :after ((operation operation) slot-names
    1876                                      &key force
     1987                                     &key force force-not
    18771988                                     &allow-other-keys)
    1878   (declare (ignorable operation slot-names force))
    1879   ;; empty method to disable initarg validity checking
     1989  ;; the &allow-other-keys disables initarg validity checking
     1990  (declare (ignorable operation slot-names force force-not))
     1991  (macrolet ((frob (x) ;; normalize forced and forced-not slots
     1992               `(when (consp (,x operation))
     1993                  (setf (,x operation)
     1994                        (mapcar #'coerce-name (,x operation))))))
     1995    (frob operation-forced) (frob operation-forced-not))
    18801996  (values))
    18811997
     
    20552171      (retry ()
    20562172        :report (lambda (s)
    2057                   (format s "~@<Retry loading ~3i~_~A.~@:>" name))
     2173                  (format s (compatfmt "~@<Retry loading ~3i~_~A.~@:>") name))
    20582174        :test
    20592175        (lambda (c)
     
    21452261      (setf (visiting-component operation c) t)
    21462262      (unwind-protect
    2147            (progn
    2148              (let ((f (operation-forced
    2149                        (operation-ancestor operation))))
    2150                (when (and f (or (not (consp f)) ;; T or :ALL
    2151                                 (and (typep c 'system) ;; list of names of systems to force
    2152                                      (member (component-name c) f
    2153                                              :test #'string=))))
    2154                  (setf *forcing* t)))
     2263           (block nil
     2264             (when (typep c 'system) ;; systems can be forced or forced-not
     2265               (let ((ancestor (operation-ancestor operation)))
     2266                 (flet ((match? (f)
     2267                          (and f (or (not (consp f)) ;; T or :ALL
     2268                                     (member (component-name c) f :test #'equal)))))
     2269                   (cond
     2270                     ((match? (operation-forced ancestor))
     2271                      (setf *forcing* t))
     2272                     ((match? (operation-forced-not ancestor))
     2273                      (return))))))
    21552274             ;; first we check and do all the dependencies for the module.
    21562275             ;; Operations planned in this loop will show up
     
    22072326                 (do-collect collect (vector module-ops))
    22082327                 (do-collect collect (cons operation c)))))
    2209              (setf (visiting-component operation c) nil)))
    2210       (visit-component operation c (when flag (incf *visit-count*)))
    2211       flag))
     2328        (setf (visiting-component operation c) nil)))
     2329    (visit-component operation c (when flag (incf *visit-count*)))
     2330    flag))
    22122331
    22132332(defun* flatten-tree (l)
     
    22282347
    22292348(defmethod traverse ((operation operation) (c component))
    2230   (when (consp (operation-forced operation))
    2231     (setf (operation-forced operation)
    2232           (mapcar #'coerce-name (operation-forced operation))))
    22332349  (flatten-tree
    22342350   (while-collecting (collect)
     
    23012417
    23022418(defun* ensure-all-directories-exist (pathnames)
    2303    (loop :for pn :in pathnames
    2304      :for pathname = (if (typep pn 'logical-pathname)
    2305                          (translate-logical-pathname pn)
    2306                          pn)
    2307      :do (ensure-directories-exist pathname)))
     2419   (dolist (pathname pathnames)
     2420     (ensure-directories-exist (translate-logical-pathname pathname))))
    23082421
    23092422(defmethod perform :before ((operation compile-op) (c source-file))
    2310   (ensure-all-directories-exist (asdf:output-files operation c)))
     2423  (ensure-all-directories-exist (output-files operation c)))
    23112424
    23122425(defmethod perform :after ((operation operation) (c component))
     
    23542467         c #'(lambda ()
    23552468               (apply *compile-op-compile-file-function* source-file
    2356                       :output-file output-file (compile-op-flags operation))))
     2469                      :output-file output-file
     2470                      :external-format (component-external-format c)
     2471                      (compile-op-flags operation))))
    23572472      (unless output
    23582473        (error 'compile-error :component c :operation operation))
     
    24602575  (let ((source (component-pathname c)))
    24612576    (setf (component-property c 'last-loaded-as-source)
    2462           (and (call-with-around-compile-hook c #'(lambda () (load source)))
     2577          (and (call-with-around-compile-hook
     2578                c #'(lambda () (load source :external-format (component-external-format c))))
    24632579               (get-universal-time)))))
    24642580
     
    25222638;;;; Separating this into a different function makes it more forward-compatible
    25232639(defun* cleanup-upgraded-asdf (old-version)
    2524   (let ((new-version (asdf:asdf-version)))
     2640  (let ((new-version (asdf-version)))
    25252641    (unless (equal old-version new-version)
    25262642      (cond
     
    25482664;;;; We need do that before we operate on anything that depends on ASDF.
    25492665(defun* upgrade-asdf ()
    2550   (let ((version (asdf:asdf-version)))
     2666  (let ((version (asdf-version)))
    25512667    (handler-bind (((or style-warning warning) #'muffle-warning))
    25522668      (operate 'load-op :asdf :verbose nil))
     
    26302746  (map () 'load-system systems))
    26312747
     2748(defun component-loaded-p (c)
     2749  (and (gethash 'load-op (component-operation-times (find-component c nil))) t))
     2750
     2751(defun loaded-systems ()
     2752  (remove-if-not 'component-loaded-p (registered-systems)))
     2753
     2754(defun require-system (s)
     2755  (load-system s :force-not (loaded-systems)))
     2756
    26322757(defun* compile-system (system &rest args &key force verbose version
    26332758                       &allow-other-keys)
    2634   "Shorthand for `(operate 'asdf:compile-op system)`. See OPERATE
     2759  "Shorthand for `(asdf:operate 'asdf:compile-op system)`. See OPERATE
    26352760for details."
    26362761  (declare (ignore force verbose version))
     
    26402765(defun* test-system (system &rest args &key force verbose version
    26412766                    &allow-other-keys)
    2642   "Shorthand for `(operate 'asdf:test-op system)`. See OPERATE for
     2767  "Shorthand for `(asdf:operate 'asdf:test-op system)`. See OPERATE for
    26432768details."
    26442769  (declare (ignore force verbose version))
     
    27642889              components pathname default-component-class
    27652890              perform explain output-files operation-done-p
    2766               weakly-depends-on
    2767               depends-on serial in-order-to do-first
     2891              weakly-depends-on depends-on serial in-order-to
     2892              do-first
    27682893              (version nil versionp)
    27692894              ;; list ends
     
    28943019;;;; As a suggested replacement which is portable to all ASDF-supported
    28953020;;;; implementations and operating systems except Genera, I recommend
    2896 ;;;; xcvb-driver's xcvb-driver:run-program/process-output-stream and its
    2897 ;;;; derivatives such as xcvb-driver:run-program/for-side-effects.
     3021;;;; xcvb-driver's xcvb-driver:run-program/ and its derivatives.
    28983022
    28993023(defun* run-shell-command (control-string &rest args)
     
    30193143
    30203144(defmethod system-source-file ((system system))
     3145  ;; might be missing when upgrading from ASDF 1 and u-i-f-r-c failed
     3146  (unless (slot-boundp system 'source-file)
     3147    (%set-system-source-file
     3148     (probe-asd (component-name system) (component-pathname system)) system))
    30213149  (%system-source-file system))
    30223150(defmethod system-source-file ((system-name string))
     
    30903218(defun* ccl-fasl-version ()
    30913219  ;; the fasl version is target-dependent from CCL 1.8 on.
    3092   (or (and (fboundp 'ccl::target-fasl-version)
    3093            (funcall 'ccl::target-fasl-version))
     3220  (or (let ((s 'ccl::target-fasl-version))
     3221        (and (fboundp s) (funcall s)))
    30943222      (and (boundp 'ccl::fasl-version)
    30953223           (symbol-value 'ccl::fasl-version))
     
    31393267           (or (architecture) (machine-type)))))
    31403268
     3269(defun* hostname ()
     3270  ;; Note: untested on RMCL
     3271  #+(or abcl clozure cmucl ecl genera lispworks mcl sbcl scl xcl) (machine-instance)
     3272  #+cormanlisp "localhost" ;; is there a better way? Does it matter?
     3273  #+allegro (excl.osi:gethostname)
     3274  #+clisp (first (split-string (machine-instance) :separator " "))
     3275  #+gcl (system:gethostname))
     3276
    31413277
    31423278;;; ---------------------------------------------------------------------------
     
    31663302  (ensure-absolute-pathname* s "from (getenv ~S)" x))
    31673303(defun getenv-absolute-pathnames (x &aux (s (getenv x)))
    3168   (split-absolute-pathnames s "from (getenv ~S) = ~S" x s))
     3304  (and (plusp (length s))
     3305       (split-absolute-pathnames s "from (getenv ~S) = ~S" x s)))
    31693306
    31703307(defun* user-configuration-directories ()
     
    33793516              (coerce-pathname (implementation-identifier) :type :directory))
    33803517             ((eql :implementation-type)
    3381               (coerce-pathname (string-downcase (implementation-type)) :type :directory)))))
     3518              (coerce-pathname (string-downcase (implementation-type)) :type :directory))
     3519             ((eql :hostname)
     3520              (coerce-pathname (hostname) :type :directory)))))
    33823521    (when (absolute-pathname-p r)
    33833522      (error (compatfmt "~@<pathname ~S is not relative~@:>") x))
     
    38654004        :for p = (or (and (typep f 'logical-pathname) f)
    38664005                     (let* ((u (ignore-errors (funcall merger f))))
    3867                        ;; The first u avoids a cumbersome (truename u) error
    3868                        (and u (equal (ignore-errors (truename u)) f) u)))
     4006                       ;; The first u avoids a cumbersome (truename u) error.
     4007                       ;; At this point f should already be a truename,
     4008                       ;; but isn't quite in CLISP, for doesn't have :version :newest
     4009                       (and u (equal (ignore-errors (truename u)) (truename f)) u)))
    38694010        :when p :collect p)
    38704011      entries))
    38714012
    38724013(defun* directory-files (directory &optional (pattern *wild-file*))
     4014  (setf directory (pathname directory))
    38734015  (when (wild-pathname-p directory)
    38744016    (error "Invalid wild in ~S" directory))
    38754017  (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal)
    38764018    (error "Invalid file pattern ~S" pattern))
     4019  (when (typep directory 'logical-pathname)
     4020    (setf pattern (make-pathname-logical pattern (pathname-host directory))))
    38774021  (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory)))))
    38784022    (filter-logical-directory-results
     
    38804024     #'(lambda (f)
    38814025         (make-pathname :defaults directory
    3882                         :name (pathname-name f) :type (ununspecific (pathname-type f))
    3883                         :version (ununspecific (pathname-version f)))))))
     4026                        :name (pathname-name f)
     4027                        :type (make-pathname-component-logical (pathname-type f))
     4028                        :version (make-pathname-component-logical (pathname-version f)))))))
    38844029
    38854030(defun* directory-asd-files (directory)
     
    39144059    (filter-logical-directory-results
    39154060     directory dirs
    3916      (let ((prefix (normalize-pathname-directory-component
    3917                     (pathname-directory directory))))
     4061     (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory))
     4062                       '(:absolute)))) ; because allegro returns NIL for #p"FOO:"
    39184063       #'(lambda (d)
    3919            (let ((dir (normalize-pathname-directory-component
    3920                        (pathname-directory d))))
     4064           (let ((dir (normalize-pathname-directory-component (pathname-directory d))))
    39214065             (and (consp dir) (consp (cdr dir))
    39224066                  (make-pathname
    39234067                   :defaults directory :name nil :type nil :version nil
    3924                    :directory (append prefix (last dir))))))))))
     4068                   :directory (append prefix (make-pathname-component-logical (last dir)))))))))))
    39254069
    39264070(defun* collect-asds-in-directory (directory collect)
Note: See TracChangeset for help on using the changeset viewer.