Changeset 14854


Ignore:
Timestamp:
09/02/16 21:43:55 (6 years ago)
Author:
Mark Evenson
Message:

asdf 3.1.7.8

Location:
trunk/abcl
Files:
2 edited

Legend:

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

    r14850 r14854  
    3737@url{https://common-lisp.net/project/asdf/asdf.html}.
    3838
    39 ASDF Copyright @copyright{} 2001-2015 Daniel Barlow and contributors.
    40 
    41 This manual Copyright @copyright{} 2001-2015 Daniel Barlow and contributors.
    42 
    43 This manual revised @copyright{} 2009-2015 Robert P. Goldman and Francois-Rene Rideau.
     39ASDF Copyright @copyright{} 2001-2016 Daniel Barlow and contributors.
     40
     41This manual Copyright @copyright{} 2001-2016 Daniel Barlow and contributors.
     42
     43This manual revised @copyright{} 2009-2016 Robert P. Goldman and Francois-Rene Rideau.
    4444
    4545Permission is hereby granted, free of charge, to any person obtaining
     
    6666@titlepage
    6767@title ASDF: Another System Definition Facility
    68 @subtitle Manual for Version 3.1.7
     68@subtitle Manual for Version 3.1.7.8
    6969@c The following two commands start the copyright page.
    7070@page
     
    8383@top ASDF: Another System Definition Facility
    8484@ifnottex
    85 Manual for Version 3.1.6.14
     85Manual for Version 3.1.7.1
    8686@end ifnottex
    8787
     
    257257* How do I work with readtables?::
    258258* How can I capture ASDF's output?::
     259* LOAD-PATHNAME has a weird value::
    259260
    260261ASDF development FAQs
     
    679680@c should not be burdened with it. [2014/02/27:rpg]
    680681
     682Novices may skip this section.
     683@c ``Experts may read it then proceed to ...''
     684@c some better section explaining
     685@c *central-registry* vs source-registry vs *system-definition-search-functions*,
     686@c and .../asdf/tools/cl-source-registry-cache.lisp
    681687
    682688The old way to configure ASDF to find your systems is by
     
    703709For example, let's say you want ASDF to find the @file{.asd} file
    704710@file{/home/me/src/foo/foo.asd}.
    705 In your lisp initialization file, you could have the following:
     711In your Lisp initialization file, you could have the following:
    706712
    707713@lisp
     
    727733A @dfn{system directory designator} is a form
    728734which will be evaluated whenever a system is to be found,
    729 and must evaluate to a directory to look in (or @code{NIL}).
     735and must evaluate to a directory to look in (or @code{nil}).
    730736By ``directory'', we mean
    731737``designator for a pathname with a non-empty DIRECTORY component''.
     
    14421448dependency-def := simple-component-name
    14431449               | ( :feature @var{feature-expression} dependency-def )
     1450                 # (@pxref{The defsystem grammar,,Feature dependencies})
    14441451               | ( :version simple-component-name version-specifier )
    14451452               | ( :require module-name )
     
    14591466method-form := (operation-name qual lambda-list @Arest{} body)
    14601467qual := method qualifier?
    1461 
    1462 component-dep-fail-option := :fail | :try-next | :ignore
    14631468
    14641469feature-expression := keyword
     
    16851690@xref{if-feature-option}.
    16861691
     1692@subsection Feature dependencies
     1693@cindex :feature dependencies
     1694
     1695A feature dependency is of the form
     1696@code{(:feature @var{feature-expression} @var{dependency})}
     1697If the @var{feature-expression} is satisfied by the running lisp at the
     1698time the system definition is parsed, then the @var{dependency} will be
     1699added to the system's dependencies.  If the @var{feature-expression} is
     1700@emph{not} satisfied, then the feature dependency form is ignored.
     1701
     1702Note that this means that @code{:feature} @strong{cannot} be used to
     1703enforce a feature dependency for the system in question.  I.e., it
     1704cannot be used to require that a feature hold in order for the system
     1705definition to be loaded.  E.g., one cannot use @code{(:feature :sbcl)}
     1706to require that a system only be used on SBCL.
     1707
     1708Feature dependencies are not to be confused with the obsolete
     1709feature requirement (@pxref{The defsystem grammar,,feature requirement}), or
     1710with @code{if-feature}.
    16871711
    16881712@subsection Using logical pathnames
     
    18441868@xref{required-features, Required features}.
    18451869
    1846 @subsection if-component-dep-fails option
    1847 @cindex :if-component-dep-fails component option
    1848 This option was removed in ASDF 3.
    1849 Its semantics was limited in purpose and dubious to explain,
    1850 and its implementation was breaking a hole into the ASDF object model.
    1851 Please use the @code{if-feature} option instead.
    1852 
    18531870@subsection feature requirement
    18541871This requirement was removed in ASDF 3.1.  Please do not use it.  In
     
    20052022ASDF is designed in an object-oriented way from the ground up.
    20062023Both a system's structure and the operations that can be performed on systems
    2007 follow a extensible protocol, allowing programmers to add new behaviours to ASDF.
     2024follow an extensible protocol, allowing programmers to add new behaviours to ASDF.
    20082025For example, @code{cffi} adds support for special FFI description files
    20092026that interface with C libraries and for wrapper files that embed C code in Lisp.
     
    27002717@enumerate
    27012718@item
    2702 @var{foundp} will be @code{T},
    2703 @item
    2704 @var{found-system} will be @code{NIL},
     2719@var{foundp} will be @code{t},
     2720@item
     2721@var{found-system} will be @code{nil},
    27052722@item
    27062723@var{pathname} will be @code{#p"/current/path/to/foo.asd"},
     
    45464563We recommend that you avoid using unprotected @code{:encoding} specifications
    45474564until after ASDF 2.21 or later becomes widespread.
    4548 As of May 2015, all maintained implementations provide ASDF 3,
     4565As of May 2016, all maintained implementations provide ASDF 3.1,
    45494566so you may prudently start using this and other features without such protection.
    45504567
     
    47544771
    47554772The below functions are not exported by ASDF itself, but by UIOP, available since ASDF 3.
    4756 Some of them have precursors in ASDF 2, but we recommend
    4757 you rely on ASDF 3 for active developments.
     4773Some of them have precursors in ASDF 2, but we recommend that for active developments,
     4774you should rely on the package UIOP as included in ASDF 3.
    47584775UIOP provides many, many more utility functions, and we recommend
    4759 you read its README and sources for more information.
     4776you read its @file{README.md} and sources for more information.
    47604777
    47614778
    47624779@defun parse-unix-namestring name @Akey{} type defaults dot-dot ensure-directory @AallowOtherKeys
    4763 Coerce NAME into a PATHNAME using standard Unix syntax.
     4780Coerce @var{name} into a @var{pathname} using standard Unix syntax.
    47644781
    47654782Unix syntax is used whether or not the underlying system is Unix;
     
    49504967See the documentation for @code{uiop:access-at}.
    49514968
    4952 @item If the object is @code{:forms}, the content is captured as a list of S-expressions,
     4969@item If the object is @code{:forms}, the content is captured as a list of s-expressions,
    49534970as read by the Lisp reader.
    49544971If the @var{count} argument is provided,
     
    55195536
    55205537@item
    5521 Now that all implementations provide ASDF 3 or later (since May 2015),
     5538Now that all implementations provide ASDF 3.1 or later (since May 2016),
    55225539the simple solution is just to use code as below in your setup,
    55235540and when it fails, upgrade your implementation or replace its ASDF.
     
    57845801* How do I work with readtables?::
    57855802* How can I capture ASDF's output?::
     5803* LOAD-PATHNAME has a weird value::
    57865804@end menu
    57875805
     
    60636081Use from the @code{named-readtables} system the macro @code{named-readtables:defreadtable}.
    60646082
    6065 @node How can I capture ASDF's output?,  , How do I work with readtables?, Issues with using and extending ASDF to define systems
     6083@node How can I capture ASDF's output?, LOAD-PATHNAME has a weird value, How do I work with readtables?, Issues with using and extending ASDF to define systems
    60666084@subsection How can I capture ASDF's output?
    60676085
     
    60746092@code{asdf:operate} should redirect all output from ASDF operations.
    60756093
    6076 
     6094@node LOAD-PATHNAME has a weird value,  , How can I capture ASDF's output?, Issues with using and extending ASDF to define systems
     6095@subsection *LOAD-PATHNAME* and *LOAD-TRUENAME* have weird values, help!
     6096@vindex *LOAD-PATHNAME*
     6097@vindex *LOAD-TRUENAME*
     6098
     6099Conventional Common Lisp code may use @code{*LOAD-TRUENAME*} or @code{*LOAD-PATHNAME*} to find
     6100files adjacent to source files.  This will generally @emph{not} work in
     6101ASDF-loaded systems.  Recall that ASDF relocates the FASL files it
     6102builds, typically to a special cache directory.  Thus the value of
     6103@code{*LOAD-PATHNAME*} and @code{*LOAD-TRUENAME*}  at load time, when ASDF is loading your system,
     6104will typically be a pathname in that cache directory, and useless to you
     6105for finding other system components.
     6106
     6107There are two ways to work around this problem:
     6108@enumerate
     6109@findex system-relative-pathname
     6110@item
     6111Use the @code{system-relative-pathname} function.  This can readily be
     6112used from outside the system, but it is probably not good software
     6113engineering to require a source file @emph{of} a system to know what
     6114system it is going to be part of.  Contained objects should not have to
     6115know their containers.
     6116@item
     6117Store the pathname at compile time, so that you get the pathname of the
     6118source file, which is presumably what you want.  To do this, you can
     6119capture the value of @code{(or *compile-file-pathname* *load-truename*)}
     6120(or @code{*LOAD-PATHNAME*}, if you prefer)
     6121in a macro expansion or other compile-time evaluated context.
     6122
     6123@end enumerate
    60776124
    60786125@node ASDF development FAQs,  , Issues with using and extending ASDF to define systems, FAQ
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r14850 r14854  
    11;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
    2 ;;; This is ASDF 3.1.7: Another System Definition Facility.
     2;;; This is ASDF 3.1.7.8: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    2020;;;  Monday; July 13, 2009)
    2121;;;
    22 ;;; Copyright (c) 2001-2015 Daniel Barlow and contributors
     22;;; Copyright (c) 2001-2016 Daniel Barlow and contributors
    2323;;;
    2424;;; Permission is hereby granted, free of charge, to any person obtaining
     
    916916      sequence)))
    917917
     918#+lispworks
     919(eval-when (:load-toplevel :compile-toplevel :execute)
     920  ;; lispworks 3 and earlier cannot be checked for so we always assume
     921  ;; at least version 4
     922  (unless (member :lispworks4 *features*)
     923    (pushnew :lispworks5+ *features*)
     924    (unless (member :lispworks5 *features*)
     925      (pushnew :lispworks6+ *features*)
     926      (unless (member :lispworks6 *features*)
     927        (pushnew :lispworks7+ *features*)))))
     928
    918929#.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl, so we use this trick
    919930      (read-from-string
     
    20332044   #:ensure-pathname ;; implemented in filesystem.lisp to accommodate for existence constraints
    20342045   ;; Wildcard pathnames
    2035    #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors* #:*wild-path* #:wilden
     2046   #:*wild* #:*wild-file* #:*wild-file-for-directory* #:*wild-directory*
     2047   #:*wild-inferiors* #:*wild-path* #:wilden
    20362048   ;; Translate a pathname
    20372049   #:relativize-directory-component #:relativize-pathname-directory
     
    26102622    (make-pathname :directory nil :name *wild* :type *wild*
    26112623                   :version (or #-(or allegro abcl xcl) *wild*))
    2612     "A pathname object with wildcards for matching any file in a given directory")
     2624    "A pathname object with wildcards for matching any file with TRANSLATE-PATHNAME")
     2625  (defparameter *wild-file-for-directory*
     2626    (make-pathname :directory nil :name *wild* :type (or #-(or clisp gcl) *wild*)
     2627                   :version (or #-(or allegro abcl clisp gcl xcl) *wild*))
     2628    "A pathname object with wildcards for matching any file with DIRECTORY")
    26132629  (defparameter *wild-directory*
    26142630    (make-pathname :directory `(:relative ,*wild-directory-component*)
     
    29052921
    29062922  (defun filter-logical-directory-results (directory entries merger)
    2907     "Given ENTRIES in a DIRECTORY, remove if the directory is logical
    2908 the entries which are physical yet when transformed by MERGER have a different TRUENAME.
    2909 This function is used as a helper to DIRECTORY-FILES to avoid invalid entries when using logical-pathnames."
    2910     (remove-duplicates ;; on CLISP, querying ~/ will return duplicates
    2911      (if (logical-pathname-p directory)
     2923    "If DIRECTORY isn't a logical pathname, return ENTRIES. If it is,
     2924given ENTRIES in the DIRECTORY, remove the entries which are physical yet
     2925when transformed by MERGER have a different TRUENAME.
     2926Also remove duplicates as may appear with some translation rules.
     2927This function is used as a helper to DIRECTORY-FILES to avoid invalid entries
     2928when using logical-pathnames."
     2929    (if (logical-pathname-p directory)
     2930        (remove-duplicates ;; on CLISP, querying ~/ will return duplicates
    29122931         ;; Try hard to not resolve logical-pathname into physical pathnames;
    29132932         ;; otherwise logical-pathname users/lovers will be disappointed.
     
    29232942                              ;; but isn't quite in CLISP, for it doesn't have :version :newest
    29242943                              (and u (equal (truename* u) (truename* f)) u)))
    2925                :when p :collect p)
    2926          entries)
    2927      :test 'pathname-equal))
    2928 
    2929 
    2930   (defun directory-files (directory &optional (pattern *wild-file*))
     2944           :when p :collect p)
     2945         :test 'pathname-equal)
     2946        entries))
     2947
     2948  (defun directory-files (directory &optional (pattern *wild-file-for-directory*))
    29312949    "Return a list of the files in a directory according to the PATTERN.
    29322950Subdirectories should NOT be returned.
     
    29462964        (setf pattern (make-pathname-logical pattern (pathname-host dir))))
    29472965      (let* ((pat (merge-pathnames* pattern dir))
    2948              (entries (append (ignore-errors (directory* pat))
    2949                               #+(or clisp gcl)
    2950                               (when (equal :wild (pathname-type pattern))
    2951                                 (ignore-errors (directory* (make-pathname :type nil :defaults pat)))))))
     2966             (entries (ignore-errors (directory* pat))))
    29522967        (remove-if 'directory-pathname-p
    29532968                   (filter-logical-directory-results
     
    29842999                       #+genera (getf (cdr x) :directory)
    29853000                       #+lispworks (lw:file-directory-p x)
    2986                        :when d :collect #+(or abcl allegro xcl) d
     3001                       :when d :collect #+(or abcl allegro xcl) (ensure-directory-pathname d)
    29873002                         #+genera (ensure-directory-pathname (first x))
    29883003                       #+(or cmucl lispworks sbcl scl) x)))
     
    33233338    "Rename a file, overwriting any previous file with the TARGET name,
    33243339in an atomic way if the implementation allows."
    3325     #+clisp ;; in recent enough versions of CLISP, :if-exists :overwrite would make it atomic
    3326     (progn (funcall 'require "syscalls")
    3327            (symbol-call :posix :copy-file source target :method :rename))
    3328     #+(and sbcl os-windows) (delete-file-if-exists target) ;; not atomic
    3329     #-clisp
    3330     (rename-file source target
    3331                  #+(or clasp clozure ecl) :if-exists #+clozure :rename-and-delete #+(or clasp ecl) t))
     3340    (let ((source (ensure-pathname source :namestring :lisp :ensure-physical t :want-file t))
     3341          (target (ensure-pathname target :namestring :lisp :ensure-physical t :want-file t)))
     3342      #+clisp ;; in recent enough versions of CLISP, :if-exists :overwrite would make it atomic
     3343      (progn (funcall 'require "syscalls")
     3344             (symbol-call :posix :copy-file source target :method :rename))
     3345      #+(and sbcl os-windows) (delete-file-if-exists target) ;; not atomic
     3346      #-clisp
     3347      (rename-file source target
     3348                   #+(or clasp clozure ecl) :if-exists
     3349                   #+clozure :rename-and-delete #+(or clasp ecl) t)))
    33323350
    33333351  (defun delete-empty-directory (directory-pathname)
     
    39693987
    39703988The temporary file's pathname will be based on concatenating
    3971 PREFIX (defaults to \"uiop\"), a random alphanumeric string,
     3989PREFIX (or \"tmp\" if it's NIL), a random alphanumeric string,
    39723990and optional SUFFIX (defaults to \"-tmp\" if a type was provided)
    39733991and TYPE (defaults to \"tmp\", using a dot as separator if not NIL),
     
    39914009      :with prefix-pn = (ensure-absolute-pathname
    39924010                         (or prefix "tmp")
    3993                          (or (ensure-pathname directory :namestring :native :ensure-directory t)
     4011                         (or (ensure-pathname
     4012                              directory
     4013                              :namestring :native
     4014                              :ensure-directory t
     4015                              :ensure-physical t)
    39944016                             #'temporary-directory))
    39954017      :with prefix-nns = (native-namestring prefix-pn)
     
    40914113A new empty file with said temporary pathname is created, to ensure there is no
    40924114clash with any concurrent process attempting the same thing."
    4093     (let* ((px (ensure-pathname x))
     4115    (let* ((px (ensure-pathname x :ensure-physical t))
    40944116           (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp"))
    4095            (directory (translate-logical-pathname (pathname-directory-pathname px))))
     4117           (directory (pathname-directory-pathname px)))
    40964118      (get-temporary-file :directory directory :prefix prefix :type (pathname-type px))))
    40974119
     
    41214143   #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments #:argv0
    41224144   #:*lisp-interaction*
    4123    #:*fatal-conditions* #:fatal-condition-p #:handle-fatal-condition
     4145   #:fatal-condition #:fatal-condition-p
     4146   #:handle-fatal-condition
    41244147   #:call-with-fatal-condition-handler #:with-fatal-condition-handler
    41254148   #:*image-restore-hook* #:*image-prelude* #:*image-entry-point*
     
    41634186    "Functions to call (in order) when before an image is dumped")
    41644187
    4165   (defvar *fatal-conditions* '(error)
    4166     "conditions that cause the Lisp image to enter the debugger if interactive,
    4167 or to die if not interactive"))
    4168 
     4188  (deftype fatal-condition ()
     4189    `(and serious-condition #+clozure (not ccl:process-reset))))
    41694190
    41704191;;; Exiting properly or im-
     
    42834304
    42844305  (defun fatal-condition-p (condition)
    4285     "Is the CONDITION fatal? It is if it matches any in *FATAL-CONDITIONS*"
    4286     (match-any-condition-p condition *fatal-conditions*))
     4306    "Is the CONDITION fatal?"
     4307    (typep condition 'fatal-condition))
    42874308
    42884309  (defun handle-fatal-condition (condition)
     
    42994320  (defun call-with-fatal-condition-handler (thunk)
    43004321    "Call THUNK in a context where fatal conditions are appropriately handled"
    4301     (handler-bind (((satisfies fatal-condition-p) #'handle-fatal-condition))
     4322    (handler-bind ((fatal-condition #'handle-fatal-condition))
    43024323      (funcall thunk)))
    43034324
     
    49374958      #+os-windows
    49384959      (string
    4939        #+mkcl (list "cmd" "/c" command)
    49404960       ;; NB: We do NOT add cmd /c here. You might want to.
    49414961       #+(or allegro clisp) command
     
    49444964       ;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858
    49454965       #+clozure (cons "cmd" (strcat "/c " command))
     4966       #+mkcl (list "cmd" "/c" command)
    49464967       #+sbcl (list (%cmd-shell-pathname) "/c" command)
    49474968       ;; NB: On other Windows implementations, this is utterly bogus
     
    49594980or whether it's already taken care of by the implementation's underlying run-program."
    49604981    (not (typep specifier '(or null string pathname (member :interactive :output)
    4961                             #+(or cmu (and sbcl os-unix) scl) (or stream (eql t))
     4982                            #+(or cmucl (and sbcl os-unix) scl) (or stream (eql t))
    49624983                            #+lispworks file-stream)))) ;; not a type!? comm:socket-stream
    49634984
     
    49754996       #+allegro nil
    49764997       #+clisp :terminal
    4977        #+(or clasp clozure cmu ecl mkcl sbcl scl) t)
    4978       #+(or allegro clasp clozure cmu ecl lispworks mkcl sbcl scl)
     4998       #+(or clozure cmucl ecl mkcl sbcl scl) t)
     4999      #+(or allegro clozure cmucl ecl lispworks mkcl sbcl scl)
    49795000      ((eql :output)
    49805001       (if (eq role :error-output)
    49815002           :output
    49825003           (error "Wrong specifier ~S for role ~S" specifier role)))))
     5004
     5005  (defun %normalize-if-exists (action)
     5006    (ecase action
     5007      (:supersede #+clisp :overwrite #-clisp action)
     5008      ((:append :error) action)))
    49835009
    49845010  (defun %interactivep (input output error-output)
     
    49925018      (t -1)))
    49935019
     5020  (defclass process-info ()
     5021    ((process :initform nil)
     5022     (input-stream :initform nil)
     5023     (output-stream :initform nil)
     5024     (bidir-stream :initform nil)
     5025     (error-output-stream :initform nil)
     5026     (exit-code :initform nil)))
     5027
    49945028  (defun %run-program (command
    49955029                       &rest keys
    49965030                       &key input (if-input-does-not-exist :error)
    4997                          output (if-output-exists :overwrite)
    4998                          error-output (if-error-output-exists :overwrite)
     5031                         output (if-output-exists :supersede)
     5032                         error-output (if-error-output-exists :supersede)
    49995033                         directory wait
    50005034                         #+allegro separate-streams
     
    50045038INPUT, OUTPUT and ERROR-OUTPUT specify a portable IO specifer,
    50055039to be normalized by %NORMALIZE-IO-SPECIFIER.
    5006 It returns a process-info plist with possible keys:
    5007      PROCESS, EXIT-CODE, INPUT-STREAM, OUTPUT-STREAM, BIDIR-STREAM, ERROR-STREAM."
     5040It returns a process-info object."
    50085041    ;; NB: these implementations have Unix vs Windows set at compile-time.
    50095042    (declare (ignorable directory if-input-does-not-exist if-output-exists if-error-output-exists))
     5043    #-(or cmucl ecl mkcl sbcl)
    50105044    (assert (not (and wait (member :stream (list input output error-output)))))
    5011     #-(or allegro clasp clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl)
     5045    #-(or allegro clisp clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
    50125046    (progn command keys directory
    50135047           (error "run-program not available"))
    5014     #+(or allegro clasp clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl)
     5048    #+(or allegro clisp clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
    50155049    (let* ((%command (%normalize-command command))
     5050           (%if-output-exists (%normalize-if-exists if-output-exists))
    50165051           (%input (%normalize-io-specifier input :input))
    50175052           (%output (%normalize-io-specifier output :output))
     
    50275062                        (assert (eq %error-output :terminal)))
    50285063              #-(or allegro mkcl sbcl) (with-current-directory (directory))
    5029               #+(or allegro clasp clisp ecl lispworks mkcl) (multiple-value-list)
     5064              #+(or allegro clisp ecl lispworks mkcl) (multiple-value-list)
    50305065              (apply
    50315066               #+allegro 'excl:run-shell-command
     
    50395074                         (apply 'ext:run-program (car %command) :arguments (cdr %command) keys))))
    50405075               #+clozure 'ccl:run-program
    5041                #+(or cmu ecl scl) 'ext:run-program
     5076               #+(or cmucl ecl scl) 'ext:run-program
    50425077               #+lispworks 'system:run-shell-command
    50435078               #+lispworks (cons "/usr/bin/env" %command) ; LW wants a full path
     
    50455080               #+sbcl 'sb-ext:run-program
    50465081               (append
    5047                 #+(or clozure cmu ecl mkcl sbcl scl) `(,(car %command) ,(cdr %command))
     5082                #+(or clozure cmucl ecl mkcl sbcl scl) `(,(car %command) ,(cdr %command))
    50485083                `(:input ,%input :output ,%output :wait ,wait :allow-other-keys t)
    50495084                #-clisp `(#+(or allegro lispworks) :error-output #-(or allegro lispworks) :error
    50505085                            ,%error-output)
    50515086                #+(and allegro os-windows) `(:show-window ,(if interactive nil :hide))
    5052                 #+(or clozure cmu ecl lispworks mkcl sbcl scl)
     5087                #+clisp `(:if-output-exists ,%if-output-exists)
     5088                #+(or allegro clozure cmucl ecl lispworks mkcl sbcl scl)
    50535089                `(:if-input-does-not-exist ,if-input-does-not-exist
    5054                   :if-output-exists ,if-output-exists
    5055                   #-lispworks :if-error-exists #+lispworks :if-error-output-exists
     5090                  :if-output-exists ,%if-output-exists
     5091                  #-(or allegro lispworks) :if-error-exists
     5092                  #+(or allegro lispworks) :if-error-output-exists
    50565093                  ,if-error-output-exists)
    50575094                #+lispworks `(:save-exit-status t)
    5058                 #+sbcl `(:search t
    5059                          :if-output-does-not-exist :create
    5060                          :if-error-does-not-exist :create)
    50615095                #+mkcl `(:directory ,(native-namestring directory))
     5096                #+sbcl `(:search t)
    50625097                #-sbcl keys
    50635098                #+sbcl (if directory keys (remove-plist-key :directory keys))))))
    5064            (process-info-r ()))
    5065       (flet ((prop (key value) (push key process-info-r) (push value process-info-r)))
     5099           (process-info (make-instance 'process-info)))
     5100      (flet ((prop (key value)
     5101               (setf (slot-value process-info key) value)))
    50665102        #+allegro
    50675103        (cond
    5068           (wait (prop :exit-code (first process*)))
     5104          (wait (prop 'exit-code (first process*)))
    50695105          (separate-streams
    50705106           (destructuring-bind (in out err pid) process*
    5071              (prop :process pid)
    5072              (when (eq input :stream) (prop :input-stream in))
    5073              (when (eq output :stream) (prop :output-stream out))
    5074              (when (eq error-output :stream) (prop :error-stream err))))
     5107             (prop 'process pid)
     5108             (when (eq input :stream) (prop 'input-stream in))
     5109             (when (eq output :stream) (prop 'output-stream out))
     5110             (when (eq error-output :stream) (prop 'error-stream err))))
    50755111          (t
    5076            (prop :process (third process*))
     5112           (prop 'process (third process*))
    50775113           (let ((x (first process*)))
    50785114             (ecase (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))
    50795115               (0)
    5080                (1 (prop :input-stream x))
    5081                (2 (prop :output-stream x))
    5082                (3 (prop :bidir-stream x))))
     5116               (1 (prop 'input-stream x))
     5117               (2 (prop 'output-stream x))
     5118               (3 (prop 'bidir-stream x))))
    50835119           (when (eq error-output :stream)
    5084              (prop :error-stream (second process*)))))
     5120             (prop 'error-stream (second process*)))))
    50855121        #+clisp
    50865122        (cond
    5087           (wait (prop :exit-code (clisp-exit-code (first process*))))
     5123          (wait (prop 'exit-code (clisp-exit-code (first process*))))
    50885124          (t
    50895125           (ecase (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))
    50905126             (0)
    5091              (1 (prop :input-stream (first process*)))
    5092              (2 (prop :output-stream (first process*)))
    5093              (3 (prop :bidir-stream (pop process*))
    5094               (prop :input-stream (pop process*))
    5095               (prop :output-stream (pop process*))))))
    5096         #+(or clozure cmu sbcl scl)
     5127             (1 (prop 'input-stream (first process*)))
     5128             (2 (prop 'output-stream (first process*)))
     5129             (3 (prop 'bidir-stream (pop process*))
     5130              (prop 'input-stream (pop process*))
     5131              (prop 'output-stream (pop process*))))))
     5132        #+(or clozure cmucl sbcl scl)
    50975133        (progn
    5098           (prop :process process*)
     5134          (prop 'process process*)
    50995135          (when (eq input :stream)
    5100             (prop :input-stream
     5136            (prop 'input-stream
    51015137                  #+clozure (ccl:external-process-input-stream process*)
    5102                   #+(or cmu scl) (ext:process-input process*)
     5138                  #+(or cmucl scl) (ext:process-input process*)
    51035139                  #+sbcl (sb-ext:process-input process*)))
    51045140          (when (eq output :stream)
    5105             (prop :output-stream
     5141            (prop 'output-stream
    51065142                  #+clozure (ccl:external-process-output-stream process*)
    5107                   #+(or cmu scl) (ext:process-output process*)
     5143                  #+(or cmucl scl) (ext:process-output process*)
    51085144                  #+sbcl (sb-ext:process-output process*)))
    51095145          (when (eq error-output :stream)
    5110             (prop :error-output-stream
     5146            (prop 'error-output-stream
    51115147                  #+clozure (ccl:external-process-error-stream process*)
    5112                   #+(or cmu scl) (ext:process-error process*)
     5148                  #+(or cmucl scl) (ext:process-error process*)
    51135149                  #+sbcl (sb-ext:process-error process*))))
    5114         #+(or clasp ecl mkcl)
    5115         (destructuring-bind #+(or clasp ecl) (stream code process) #+mkcl (stream process code) process*
     5150        #+(or ecl mkcl)
     5151        (destructuring-bind #+ecl (stream code process) #+mkcl (stream process code) process*
    51165152          (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))))
    51175153            (cond
    51185154              ((zerop mode))
    5119               ((null process*) (prop :exit-code -1))
    5120               (t (prop (case mode (1 :input-stream) (2 :output-stream) (3 :bidir-stream)) stream))))
    5121           (when code (prop :exit-code code))
    5122           (when process (prop :process process)))
     5155              ((null process*) (prop 'exit-code -1))
     5156              (t (prop (case mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream)) stream))))
     5157          (when code (prop 'exit-code code))
     5158          (when process (prop 'process process)))
    51235159        #+lispworks
    51245160        (if wait
    5125             (prop :exit-code (first process*))
     5161            (prop 'exit-code (or (second process*) (first process*)))
    51265162            (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))))
    5127               (if (zerop mode)
    5128                   (prop :process (first process*))
    5129                   (destructuring-bind (x err pid) process*
    5130                     (prop :process pid)
    5131                     (prop (ecase mode (1 :input-stream) (2 :output-stream) (3 :bidir-stream)) x)
    5132                     (when (eq error-output :stream) (prop :error-stream err))))))
    5133         (nreverse process-info-r))))
     5163              (if (or (plusp mode) (eq error-output :stream))
     5164                  (destructuring-bind (io err pid) process*
     5165                    #+lispworks7+ (declare (ignore pid))
     5166                    (prop 'process #+lispworks7+ io #-lispworks7+ pid)
     5167                    (when (plusp mode)
     5168                      (prop (ecase mode
     5169                              (1 'input-stream)
     5170                              (2 'output-stream)
     5171                              (3 'bidir-stream)) io))
     5172                    (when (eq error-output :stream)
     5173                      (prop 'error-stream err)))
     5174                  ;; lispworks6 returns (pid), lispworks7 returns (io,err,pid).
     5175                  (prop 'process (first process*)))))
     5176        process-info)))
    51345177
    51355178  (defun %process-info-pid (process-info)
    5136     (let ((process (getf process-info :process)))
     5179    (let ((process (slot-value process-info 'process)))
    51375180      (declare (ignorable process))
    5138       #+(or allegro lispworks) process
    5139       #+clozure (ccl::external-process-pid process)
    5140       #+(or clasp ecl) (si:external-process-pid process)
    5141       #+(or cmu scl) (ext:process-pid process)
     5181      #+allegro process
     5182      #+clozure (ccl:external-process-id process)
     5183      #+ecl (ext:external-process-pid process)
     5184      #+(or cmucl scl) (ext:process-pid process)
     5185      #+lispworks7+ (sys:pipe-pid process)
     5186      #+(and lispworks (not lispworks7+)) process
    51425187      #+mkcl (mkcl:process-id process)
    51435188      #+sbcl (sb-ext:process-pid process)
    5144       #-(or allegro cmu mkcl sbcl scl) (error "~S not implemented" '%process-info-pid)))
     5189      #-(or allegro clozure cmucl ecl mkcl lispworks sbcl scl)
     5190      (error "~S not implemented" '%process-info-pid)))
    51455191
    51465192  (defun %wait-process-result (process-info)
    5147     (or (getf process-info :exit-code)
    5148         (let ((process (getf process-info :process)))
     5193    (or (slot-value process-info 'exit-code)
     5194        (let ((process (slot-value process-info 'process)))
     5195          #-(or allegro clozure cmucl ecl lispworks mkcl sbcl scl)
     5196          (error "~S not implemented" '%wait-process)
    51495197          (when process
    51505198            ;; 1- wait
    51515199            #+clozure (ccl::external-process-wait process)
    5152             #+(or cmu scl) (ext:process-wait process)
     5200            #+(or cmucl scl) (ext:process-wait process)
    51535201            #+sbcl (sb-ext:process-wait process)
    51545202            ;; 2- extract result
    5155             #+allegro (sys:reap-os-subprocess :pid process :wait t)
    5156             #+clozure (nth-value 1 (ccl:external-process-status process))
    5157             #+(or cmu scl) (ext:process-exit-code process)
    5158             #+(or clasp ecl) (nth-value 1 (ext:external-process-wait process t))
    5159             #+lispworks
    5160             (if-let ((stream (or (getf process-info :input-stream)
    5161                                  (getf process-info :output-stream)
    5162                                  (getf process-info :bidir-stream)
    5163                                  (getf process-info :error-stream))))
    5164               (system:pipe-exit-status stream :wait t)
    5165               (if-let ((f (find-symbol* :pid-exit-status :system nil)))
    5166                 (funcall f process :wait t)))
    5167             #+sbcl (sb-ext:process-exit-code process)
    5168             #+mkcl (mkcl:join-process process)))))
     5203            (let ((exit-code
     5204                   #+allegro (multiple-value-bind (exit-code pid signal)
     5205                                 (sys:reap-os-subprocess :pid process :wait t)
     5206                               (assert pid)
     5207                               (or signal exit-code))
     5208                   #+clozure (nth-value 1 (ccl:external-process-status process))
     5209                   #+(or cmucl scl) (ext:process-exit-code process)
     5210                   #+ecl (nth-value 1 (ext:external-process-wait process t))
     5211                   #+lispworks
     5212                   ;; a signal is only returned on LispWorks 7+
     5213                   (multiple-value-bind (exit-code signal)
     5214                       (funcall #+lispworks7+ #'sys:pipe-exit-status
     5215                                #-lispworks7+ #'sys:pid-exit-status
     5216                                process :wait t)
     5217                     (or signal exit-code))
     5218                   #+mkcl (mkcl:join-process process)
     5219                   #+sbcl (sb-ext:process-exit-code process)))
     5220              (setf (slot-value process-info 'exit-code) exit-code)
     5221              exit-code)))))
    51695222
    51705223  (defun %check-result (exit-code &key command process ignore-error-status)
     
    52245277          ((or null string pathname (eql :interactive))
    52255278           (easy-case))
    5226           #+(or cmu (and sbcl os-unix) scl) ;; streams are only easy on implementations that try very hard
     5279          #+(or cmucl (and sbcl os-unix) scl) ;; streams are only easy on implementations that try very hard
    52275280          (stream
    52285281           (if stream-easy-p (easy-case) (hard-case)))
     
    52975350                           keys)))
    52985351              (labels ((get-stream (stream-name &optional fallbackp)
    5299                          (or (getf process-info stream-name)
     5352                         (or (slot-value process-info stream-name)
    53005353                             (when fallbackp
    5301                                (getf process-info :bidir-stream))))
     5354                               (slot-value process-info 'bidir-stream))))
    53025355                       (run-activity (activity stream-name &optional fallbackp)
    53035356                         (if-let (stream (get-stream stream-name fallbackp))
     
    53095362                     (ecase activity
    53105363                       ((nil))
    5311                        (:input (run-activity input-activity :input-stream t))
    5312                        (:output (run-activity output-activity :output-stream t))
    5313                        (:error-output (run-activity error-output-activity :error-output-stream)))
    5314                   (loop :for (() val) :on process-info :by #'cddr
    5315                         :when (streamp val) :do (ignore-errors (close val)))
     5364                       (:input (run-activity input-activity 'input-stream t))
     5365                       (:output (run-activity output-activity 'output-stream t))
     5366                       (:error-output (run-activity error-output-activity 'error-output-stream)))
     5367                  (dolist (stream
     5368                            (cons (slot-value process-info 'error-output-stream)
     5369                                  (if-let (bidir-stream (slot-value process-info 'bidir-stream))
     5370                                          (list bidir-stream)
     5371                                          (list (slot-value process-info 'input-stream)
     5372                                                (slot-value process-info 'output-stream)))))
     5373                    (when stream (close stream)))
    53165374                  (setf exit-code
    53175375                        (%check-result (%wait-process-result process-info)
     
    53685426    "A portable abstraction of a low-level call to libc's system()."
    53695427    (declare (ignorable input output error-output directory keys))
    5370     #+(or allegro clozure cmu (and lispworks os-unix) sbcl scl)
     5428    #+(or allegro clozure cmucl (and lispworks os-unix) sbcl scl)
    53715429    (%wait-process-result
    53725430     (apply '%run-program (%normalize-system-command command) :wait t keys))
     
    54145472                       &key ignore-error-status (force-shell nil force-shell-suppliedp)
    54155473                         (input nil inputp) (if-input-does-not-exist :error)
    5416                          output (if-output-exists :overwrite)
    5417                          (error-output nil error-output-p) (if-error-output-exists :overwrite)
     5474                         output (if-output-exists :supersede)
     5475                         (error-output nil error-output-p) (if-error-output-exists :supersede)
    54185476                         (element-type #-clozure *default-stream-element-type* #+clozure 'character)
    54195477                         (external-format *utf-8-external-format*)
     
    54735531or an indication of failure via the EXIT-CODE of the process"
    54745532    (declare (ignorable ignore-error-status))
    5475     #-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl)
     5533    #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl)
    54765534    (error "RUN-PROGRAM not implemented for this Lisp")
    54775535    ;; per doc string, set FORCE-SHELL to T if we get command as a string.  But
     
    61686226             (or output-file
    61696227                 (apply 'compile-file-pathname* input-file :output-file output-file keywords)))
     6228           (physical-output-file (physicalize-pathname output-file))
    61706229           #+(or clasp ecl)
    61716230           (object-file
     
    61786237             (or object-file
    61796238                 (compile-file-pathname output-file :fasl-p nil)))
    6180            (tmp-file (tmpize-pathname output-file))
     6239           (tmp-file (tmpize-pathname physical-output-file))
    61816240           #+sbcl
    61826241           (cfasl-file (etypecase emit-cfasl
    61836242                         (null nil)
    6184                          ((eql t) (make-pathname :type "cfasl" :defaults output-file))
     6243                         ((eql t) (make-pathname :type "cfasl" :defaults physical-output-file))
    61856244                         (string (parse-namestring emit-cfasl))
    61866245                         (pathname emit-cfasl)))
     
    62216280                  (or (not compile-check)
    62226281                      (apply compile-check input-file
    6223                              :output-file #-(or clasp ecl) output-file #+(or clasp ecl) tmp-file
     6282                             :output-file output-truename
    62246283                             keywords))))
    6225            (delete-file-if-exists output-file)
     6284           (delete-file-if-exists physical-output-file)
    62266285           (when output-truename
    62276286             #+clasp (when output-truename (rename-file-overwriting-target tmp-file output-truename))
    6228              #+clisp (when lib-file (rename-file-overwriting-target tmp-lib lib-file))
     6287             ;; see CLISP bug 677
     6288             #+clisp
     6289             (progn
     6290               (setf tmp-lib (make-pathname :type "lib" :defaults output-truename))
     6291               (unless lib-file (setf lib-file (make-pathname :type "lib" :defaults physical-output-file)))
     6292               (rename-file-overwriting-target tmp-lib lib-file))
    62296293             #+sbcl (when cfasl-file (rename-file-overwriting-target tmp-cfasl cfasl-file))
    6230              (rename-file-overwriting-target output-truename output-file)
    6231              (setf output-truename (truename output-file)))
     6294             (rename-file-overwriting-target output-truename physical-output-file)
     6295             (setf output-truename (truename physical-output-file)))
    62326296           #+clasp (delete-file-if-exists tmp-file)
    6233            #+clisp (delete-file-if-exists tmp-lib))
     6297           #+clisp (progn (delete-file-if-exists tmp-file) ;; this one works around clisp BUG 677
     6298                          (delete-file-if-exists tmp-lib))) ;; this one is "normal" defensive cleanup
    62346299          (t ;; error or failed check
    62356300           (delete-file-if-exists output-truename)
     
    62646329  (defun combine-fasls (inputs output)
    62656330    "Combine a list of FASLs INPUTS into a single FASL OUTPUT"
    6266     #-(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl)
     6331    #-(or abcl allegro clisp clozure cmucl lispworks sbcl scl xcl)
    62676332    (error "~A does not support ~S~%inputs ~S~%output  ~S"
    62686333           (implementation-type) 'combine-fasls inputs output)
    62696334    #+abcl (funcall 'sys::concatenate-fasls inputs output) ; requires ABCL 1.2.0
    6270     #+(or allegro clisp cmu sbcl scl xcl) (concatenate-files inputs output)
     6335    #+(or allegro clisp cmucl sbcl scl xcl) (concatenate-files inputs output)
    62716336    #+clozure (ccl:fasl-concatenate output inputs :if-exists :supersede)
    62726337    #+lispworks
     
    68506915         ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
    68516916         ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
    6852          (asdf-version "3.1.7")
     6917         (asdf-version "3.1.7.8")
    68536918         (existing-version (asdf-version)))
    68546919    (setf *asdf-version* asdf-version)
     
    93909455              ((style-warning #'muffle-warning)
    93919456               (missing-component (constantly nil))
    9392                (error #'(lambda (e)
     9457               (uiop:fatal-condition #'(lambda (e)
    93939458                          (format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%")
    93949459                                  name e))))
     
    98059870                   (recurse-beyond-asds *recurse-beyond-asds*) ignore-cache)
    98069871    (let ((visited (make-hash-table :test 'equalp)))
    9807       (collect-sub*directories
    9808        directory
    9809        #'(lambda (dir)
    9810            (unless (and (not ignore-cache) (process-source-registry-cache directory collect))
    9811              (let ((asds (collect-asds-in-directory dir collect)))
    9812                (or recurse-beyond-asds (not asds)))))
    9813        #'(lambda (x)                    ; x will be a directory pathname
    9814            (and
    9815             (not (member (car (last (pathname-directory x))) exclude :test #'equal))
    9816             (flet ((pathname-key (x)
    9817                      (namestring (truename* x))))
    9818               (let ((visitedp (gethash (pathname-key x) visited)))
    9819                 (if visitedp nil
    9820                     (setf (gethash (pathname-key x) visited) t))))))
    9821        (constantly nil))))
     9872      (flet ((collectp (dir)
     9873               (unless (and (not ignore-cache) (process-source-registry-cache directory collect))
     9874                 (let ((asds (collect-asds-in-directory dir collect)))
     9875                   (or recurse-beyond-asds (not asds)))))
     9876             (recursep (x)                    ; x will be a directory pathname
     9877               (and
     9878                (not (member (car (last (pathname-directory x))) exclude :test #'equal))
     9879                (flet ((pathname-key (x)
     9880                         (namestring (truename* x))))
     9881                  (let ((visitedp (gethash (pathname-key x) visited)))
     9882                    (if visitedp nil
     9883                        (setf (gethash (pathname-key x) visited) t)))))))
     9884      (collect-sub*directories directory #'collectp #'recursep (constantly nil)))))
    98229885
    98239886  (defun validate-source-registry-directive (directive)
Note: See TracChangeset for help on using the changeset viewer.