Changeset 14714


Ignore:
Timestamp:
07/18/14 17:03:20 (7 years ago)
Author:
Mark Evenson
Message:

ASDF 3.1.2.9

changeset: 2488:0a1ded36af37
bookmark: master
tag: default/master
tag: tip
user: Francois-Rene Rideau <tunes@…>
summary: Tweak the debian changelog.

Location:
trunk/abcl
Files:
2 edited

Legend:

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

    r14713 r14714  
    910910@end defun
    911911
     912@vindex *image-dump-hook*
    912913This function is pushed onto the @code{uiop:*image-dump-hook*} by default,
    913914which means that if you save an image using @code{uiop:dump-image},
     
    23892390@end itemize
    23902391
     2392@cindex ASDF-USER package
    23912393When system definitions are loaded from @file{.asd} files,
    2392 a new scratch package is created for them to load into,
    2393 so that different systems do not overwrite each others operations.
    2394 The user may also wish to (and is recommended to)
    2395 include @code{defpackage} and @code{in-package} forms
    2396 in his system definition files, however,
    2397 so that they can be loaded manually if need be.
     2394they are implicitly loaded into the @code{ASDF-USER} package,
     2395which uses @code{ASDF}, @code{UIOP} and @code{UIOP/COMMON-LISP}@footnote{
     2396Note that between releases 2.27 and 3.0.3, only @code{UIOP/PACKAGE},
     2397not all of @code{UIOP}, was used; if you want your code to work
     2398with releases earlier than 3.1.2, you may have to explicitly define a package
     2399that uses @code{UIOP}, or use proper package prefix to your symbols, as in
     2400@code{uiop:version<}.}
     2401Programmers who do anything non-trivial in a @file{.asd} file,
     2402such as defining new variables, functions or classes,
     2403should include @code{defpackage} and @code{in-package} forms in this file,
     2404so they will not overwrite each others' extensions.
     2405Such forms might also help the files behave identically
     2406if loaded manually with @code{cl:load} for development or debugging,
     2407though we recommend you use the function @code{asdf::load-asd} instead,
     2408which the @code{slime-asdf} contrib knows about.
    23982409
    23992410The default value of @code{*system-definition-search-functions*}
    2400 is a list of two functions.
     2411is a list of three functions.
    24012412The first function looks in each of the directories given
    24022413by evaluating members of @code{*central-registry*}
    2403 for a file whose name is the name of the system and whose type is @file{asd}.
    2404 The first such file is returned,
     2414for a file whose name is the name of the system and whose type is @file{asd};
     2415the first such file is returned,
    24052416whether or not it turns out to actually define the appropriate system.
    24062417The second function does something similar,
    2407 for the directories specified in the @code{source-registry}.
    2408 Hence, it is strongly advised to define a system
    2409 @var{foo} in the corresponding file @var{foo.asd}.
     2418for the directories specified in the @code{source-registry},
     2419but searches the filesystem only once and caches its results.
     2420The third function makes the @code{package-inferred-system} extension work,
     2421@pxref{The package-inferred-system extension}.
     2422
     2423Because of the way these search functions are defined,
     2424you should put the definition for a system
     2425@var{foo} in a file named @file{foo.asd},
     2426in a directory that is
     2427in the central registry or
     2428which can be found using the
     2429source registry configuration.
     2430
     2431@c FIXME: Move this discussion to the system definition grammar, or somewhere else.
     2432@anchor{System names}
     2433@cindex System names
     2434@cindex Primary system name
     2435@findex primary-system-name
     2436It is often useful to define multiple systems in a same file,
     2437but ASDF can only locate a system's definition file based on the system
     2438name.
     2439For this reason,
     2440ASDF 3's system search algorithm has been extended to
     2441allow a file @file{foo.asd} to contain
     2442secondary systems named @var{foo/bar}, @var{foo/baz}, @var{foo/quux}, etc.,
     2443in addition to the primary system named @var{foo}.
     2444The first component of a system name,
     2445separated by the slash character, @code{/},
     2446is called the primary name of a system.
     2447The primary name may be
     2448extracted by function @code{asdf::primary-system-name};
     2449when ASDF 3 is told to find a system whose name has a slash,
     2450it will first attempt to load the corresponding primary system,
     2451and will thus see any such definitions, and/or any
     2452definition of a @code{package-inferred-system}.@footnote{
     2453ASDF 2.26 and earlier versions
     2454do not support this primary system name convention.
     2455With these versions of ASDF
     2456you must explicitly load @file{foo.asd}
     2457before you can use system @var{foo/bar} defined therein,
     2458e.g. using @code{(asdf:find-system "foo")}.
     2459We do not support ASDF 2, and recommend that you should upgrade to ASDF 3.
     2460}
     2461If your file @file{foo.asd} also defines systems
     2462that do not follow this convention, e.g., a system named @var{foo-test},
     2463ASDF will not be able to automatically locate a definition for these systems,
     2464and will only see their definition
     2465if you explicitly find or load the primary system
     2466using e.g. @code{(asdf:find-system "foo")} before you try to use them.
     2467We strongly recommend against this practice,
     2468though it is currently supported for backward compatibility.
     2469
     2470@end defun
     2471
     2472@defun primary-system-name name
     2473
     2474Internal (not exported) function, @code{asdf::primary-system-name}.
     2475Returns the primary system name (the portion before
     2476the slash, @code{/}, in a secondary system name) from @var{name}.
     2477
     2478@end defun
     2479
     2480@defun locate-system name
     2481
     2482This function should typically @emph{not} be invoked directly.  It is
     2483exported as part of the API only for programmers who wish to provide
     2484their own @code{*system-definition-search-functions*}.
     2485
     2486Given a system @var{name} designator,
     2487try to locate where to load the system definition from.
     2488@c (This does not include the loading of the system definition,
     2489@c which is done by @code{find-system},
     2490@c or the loading of the system itself, which is done by @code{load-system};
     2491@c however, for systems the definition of which has already been loaded,
     2492@c @code{locate-system} may return an object of class @code{system}.)
     2493Returns five values: @var{foundp}, @var{found-system}, @var{pathname},
     2494@var{previous}, and @var{previous-time}.
     2495@var{foundp} is true when a system was found,
     2496either a new as yet unregistered one, or a previously registered one.
     2497The @var{found-system} return value
     2498will be a @code{system} object, if a system definition is found in your
     2499source registry.
     2500@c This system may be registered (by @code{register-system}) or may not, if
     2501@c it's preloaded code.  Fare writes:
     2502@c In the case of preloaded code, as for "asdf", "uiop", etc.,
     2503@c themselves, the system objects are not registered until after they are
     2504@c initially located by sysdef-preloaded-system-search as a fallback when
     2505@c no source code was found.
     2506The system definition will @emph{not} be
     2507loaded if it hasn't been loaded already.
     2508@var{pathname} when not null is a path from which to load the system,
     2509either associated with @var{found-system}, or with the @var{previous} system.
     2510If @var{previous} is not null, it will be a @emph{previously loaded}
     2511@code{system} object of the same name (note that the system
     2512@emph{definition} is previously-loaded: the system itself may or may not be).
     2513@var{previous-time} when not null is
     2514the timestamp of the previous system definition file, at the
     2515time when the @var{previous} system definition was loaded.
     2516
     2517For example, if your current registry has @file{foo.asd} in
     2518@file{/current/path/to/foo.asd},
     2519but system @code{foo} was previously loaded from @file{/previous/path/to/foo.asd}
     2520then @var{locate-system} will return the following values:
     2521@enumerate
     2522@item
     2523@var{foundp} will be @code{T},
     2524@item
     2525@var{found-system} will be @code{NIL},
     2526@item
     2527@var{pathname} will be @code{#p"/current/path/to/foo.asd"},
     2528@item
     2529@var{previous} will be an object of type @code{SYSTEM} with
     2530@code{system-source-file} slot value of
     2531@code{#p"/previous/path/to/foo.asd"}
     2532@item
     2533@var{previous-time} will be the timestamp of
     2534@code{#p"/previous/path/to/foo.asd"} at the time it was loaded.
     2535@end enumerate
    24102536@end defun
    24112537
     
    27262852component classes and specializing methods on the new component class.
    27272853
    2728 @emph{FIXME: this should perhaps be explained more throughly,
    2729 not only by example ...}
     2854@c FIXME: this should perhaps be explained more throughly,
     2855@c not only by example ...
    27302856
    27312857As an example, suppose we have some implementation-dependent
     
    27702896@c here....  Also needs to be revised to be coherent.
    27712897
    2772 To be successfully buildable, this graph of actions but be acyclic.
    2773 If, as a user, extender or implementer of ASDF, you fail
    2774 to keep the dependency graph without cycles,
    2775 ASDF will fail loudly as it eventually finds one.
     2898To be successfully build-able, this graph of actions must be acyclic.
     2899If, as a user, extender or implementer of ASDF, you introduce
     2900a cycle into the dependency graph,
     2901ASDF will fail loudly.
    27762902To clearly distinguish the direction of dependencies,
    27772903ASDF 3 uses the words @emph{requiring} and @emph{required}
     
    29643090because it is easier to setup in a portable way across users and implementations.
    29653091
    2966 Addtionally, some people dislike truename,
     3092Additionally, some people dislike truename,
    29673093either because it is very slow on their system, or
    29683094because they are using content-addressed storage where the truename of a file
     
    32523378ASDF will skip to next configuration if it's an empty string.
    32533379It will @code{READ} the string as a SEXP in the DSL
    3254 if it begins with a paren @code{(}
    3255 and it will be interpreted much like @code{TEXINPUTS}
    3256 list of paths, where
     3380if it begins with a paren @code{(},
     3381otherwise it will be interpreted much like @code{TEXINPUTS},
     3382as a list of paths, where
    32573383
    32583384  * paths are separated
     
    37103836             ;; the pathname to be translated and the matching
    37113837             ;; DIRECTORY-DESIGNATOR
    3712     LAMBDA   ;; A form which evalutates to a function taking two arguments:
     3838    LAMBDA   ;; A form which evaluates to a function taking two arguments:
    37133839             ;; the pathname to be translated and the matching
    37143840             ;; DIRECTORY-DESIGNATOR
     
    37713897If the @code{translate-pathname} mechanism cannot achieve a desired
    37723898translation, the user may provide a function which provides the
    3773 required algorithim.  Such a translation function is specified by
     3899required algorithm.  Such a translation function is specified by
    37743900supplying a list as the second @code{directory-designator}
    37753901the first element of which is the keyword @code{:function},
     
    56145740
    56155741@bye
     5742
     5743@c  LocalWords:  clbuild tarballs defsystem Quicklisp initarg uiop fasl
     5744@c  LocalWords:  namestring initargs fasls
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r14713 r14714  
    11;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
    2 ;;; This is ASDF 3.1.2.2: Another System Definition Facility.
     2;;; This is ASDF 3.1.2.9: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    403403                       (t (push name intern)))))))
    404404        (labels ((sort-names (names)
    405                    (sort names #'string<))
     405                   (sort (copy-list names) #'string<))
    406406                 (table-keys (table)
    407407                   (loop :for k :being :the :hash-keys :of table :collect k))
     
    846846(uiop/package:define-package :uiop/common-lisp
    847847  (:nicknames :uoip/cl :asdf/common-lisp :asdf/cl)
    848   (:use #-genera :common-lisp #+genera :future-common-lisp :uiop/package)
    849   (:reexport :common-lisp)
     848  (:use :uiop/package)
     849  (:use-reexport #-genera :common-lisp #+genera :future-common-lisp)
    850850  (:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf)
    851851  #+allegro (:intern #:*acl-warn-save*)
     
    856856   #:make-broadcast-stream #:file-namestring)
    857857  #+genera (:shadowing-import-from :scl #:boolean)
    858   #+genera (:export #:boolean #:ensure-directories-exist)
     858  #+genera (:export #:boolean #:ensure-directories-exist #:read-sequence #:write-sequence)
    859859  #+mcl (:shadow #:user-homedir-pathname))
    860860(in-package :uiop/common-lisp)
     
    936936#+genera
    937937(eval-when (:load-toplevel :compile-toplevel :execute)
     938  (unless (fboundp 'lambda)
     939    (defmacro lambda (&whole form &rest bvl-decls-and-body)
     940      (declare (ignore bvl-decls-and-body)(zwei::indentation 1 1))
     941      `#',(cons 'lisp::lambda (cdr form))))
    938942  (unless (fboundp 'ensure-directories-exist)
    939943    (defun ensure-directories-exist (path)
    940       (fs:create-directories-recursively (pathname path)))))
     944      (fs:create-directories-recursively (pathname path))))
     945  (unless (fboundp 'read-sequence)
     946    (defun read-sequence (sequence stream &key (start 0) end)
     947      (scl:send stream :string-in nil sequence start end)))
     948  (unless (fboundp 'write-sequence)
     949    (defun write-sequence (sequence stream &key (start 0) end)
     950      (scl:send stream :string-out sequence start end)
     951      sequence)))
    941952
    942953#.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl, so we use this trick
     
    12141225;;; Characters
    12151226(with-upgradability () ;; base-char != character on ECL, LW, SBCL, Genera. LW also has SIMPLE-CHAR.
    1216   (defconstant +non-base-chars-exist-p+ (not (subtypep 'character 'base-char)))
     1227  (defconstant +non-base-chars-exist-p+ #.(not (subtypep 'character 'base-char)))
    12171228  #-scl ;; In SCL, all characters seem to be 16-bit base-char, but this flag gets set somehow???
    12181229  (when +non-base-chars-exist-p+ (pushnew :non-base-chars-exist-p *features*)))
     
    13911402      (function fun)
    13921403      ((or boolean keyword character number pathname) (constantly fun))
    1393       (hash-table (lambda (x) (gethash x fun)))
     1404      (hash-table #'(lambda (x) (gethash x fun)))
    13941405      (symbol (fdefinition fun))
    13951406      (cons (if (eq 'lambda (car fun))
     
    17511762    "The operating system of the current host"
    17521763    (first-feature
    1753      '(:cygwin (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first!
     1764     '(:cygwin
     1765       (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first!
    17541766       (:linux :linux :linux-target) ;; for GCL at least, must appear before :bsd
    17551767       (:macosx :macosx :darwin :darwin-target :apple) ; also before :bsd
    1756        (:solaris :solaris :sunos) (:bsd :bsd :freebsd :netbsd :openbsd) :unix
     1768       (:solaris :solaris :sunos)
     1769       (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly)
     1770       :unix
    17571771       :genera)))
    17581772
     
    25532567when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH."
    25542568    (let ((sub (when maybe-subpath (pathname maybe-subpath)))
    2555     (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname)))))
     2569          (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname)))))
    25562570      (or (and base (subpathp sub base)) sub)))
    25572571
     
    32983312    #+cormanlisp (win32:delete-directory directory-pathname)
    32993313    #+ecl (si:rmdir directory-pathname)
     3314    #+genera (fs:delete-directory directory-pathname)
    33003315    #+lispworks (lw:delete-directory directory-pathname)
    33013316    #+mkcl (mkcl:rmdir directory-pathname)
     
    33043319               `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname)))
    33053320    #+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname)))
    3306     #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks mkcl sbcl scl xcl)
     3321    #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl)
    33073322    (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera
    33083323
     
    33383353              'delete-filesystem-tree directory-pathname))
    33393354         (:ignore nil)))
    3340       #-(or allegro cmu clozure sbcl scl)
     3355      #-(or allegro cmu clozure genera sbcl scl)
    33413356      ((os-unix-p) ;; On Unix, don't recursively walk the directory and delete everything in Lisp,
    33423357       ;; except on implementations where we can prevent DIRECTORY from following symlinks;
     
    33483363                              directory-pathname :if-does-not-exist if-does-not-exist)
    33493364       #+clozure (ccl:delete-directory directory-pathname)
    3350        #+genera (error "~S not implemented on ~S" 'delete-directory-tree (implementation-type))
     3365       #+genera (fs:delete-directory directory-pathname :confirm nil)
    33513366       #+sbcl #.(if-let (dd (find-symbol* :delete-directory :sb-ext nil))
    33523367                  `(,dd directory-pathname :recursive t) ;; requires SBCL 1.0.44 or later
     
    39964011           (afterf (gensym "AFTER")))
    39974012      `(flet (,@(when before
    3998                   `((,beforef (,@(when streamp `(,stream)) ,@(when pathnamep `(,pathname))) ,@before)))
     4013                  `((,beforef (,@(when streamp `(,stream)) ,@(when pathnamep `(,pathname)))
     4014                       ,@(when after `((declare (ignorable ,pathname))))
     4015                       ,@before)))
    39994016              ,@(when after
    40004017                  (assert pathnamep)
     
    41214138    #+ecl (si:quit code)
    41224139    #+gcl (system:quit code)
    4123     #+genera (error "You probably don't want to Halt the Machine. (code: ~S)" code)
     4140    #+genera (error "~S: You probably don't want to Halt Genera. (code: ~S)" 'quit code)
    41244141    #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
    41254142    #+mcl (progn code (ccl:quit)) ;; or should we use FFI to call libc's exit(3) ?
     
    41454162    #+abcl
    41464163    (loop :for i :from 0
    4147     :for frame :in (sys:backtrace (or count most-positive-fixnum)) :do
    4148       (safe-format! stream "~&~D: ~A~%" i frame))
     4164          :for frame :in (sys:backtrace (or count most-positive-fixnum)) :do
     4165            (safe-format! stream "~&~D: ~A~%" i frame))
    41494166    #+allegro
    41504167    (let ((*terminal-io* stream)
     
    41704187    #+(or ecl mkcl)
    41714188    (let* ((top (si:ihs-top))
    4172      (repeats (if count (min top count) top))
    4173      (backtrace (loop :for ihs :from 0 :below top
     4189           (repeats (if count (min top count) top))
     4190           (backtrace (loop :for ihs :from 0 :below top
    41744191                            :collect (list (si::ihs-fun ihs)
    41754192                                           (si::ihs-env ihs)))))
    41764193      (loop :for i :from 0 :below repeats
    4177       :for frame :in (nreverse backtrace) :do
    4178         (safe-format! stream "~&~D: ~S~%" i frame)))
     4194            :for frame :in (nreverse backtrace) :do
     4195              (safe-format! stream "~&~D: ~S~%" i frame)))
    41794196    #+gcl
    41804197    (let ((*debug-io* stream))
    41814198      (ignore-errors
    41824199       (with-safe-io-syntax ()
    4183   (if condition
    4184        (conditions::condition-backtrace condition)
    4185        (system::simple-backtrace)))))
     4200        (if condition
     4201             (conditions::condition-backtrace condition)
     4202             (system::simple-backtrace)))))
    41864203    #+lispworks
    41874204    (let ((dbg::*debugger-stack*
     
    41974214    #+xcl
    41984215    (loop :for i :from 0 :below (or count most-positive-fixnum)
    4199     :for frame :in (extensions:backtrace-as-list) :do
    4200       (safe-format! stream "~&~D: ~S~%" i frame)))
     4216          :for frame :in (extensions:backtrace-as-list) :do
     4217            (safe-format! stream "~&~D: ~S~%" i frame)))
    42014218
    42024219  (defun print-backtrace (&rest keys &key stream count condition)
     
    42984315      #-(or sbcl allegro)
    42994316      (unless (eq *image-dumped-p* :executable)
    4300   ;; LispWorks command-line processing isn't transparent to the user
    4301   ;; unless you create a standalone executable; in that case,
    4302   ;; we rely on cl-launch or some other script to set the arguments for us.
    4303   #+lispworks (return *command-line-arguments*)
    4304   ;; On other implementations, on non-standalone executables,
    4305   ;; we trust cl-launch or whichever script starts the program
    4306   ;; to use -- as a delimiter between implementation arguments and user arguments.
    4307   #-lispworks (setf arguments (member "--" arguments :test 'string-equal)))
     4317        ;; LispWorks command-line processing isn't transparent to the user
     4318        ;; unless you create a standalone executable; in that case,
     4319        ;; we rely on cl-launch or some other script to set the arguments for us.
     4320        #+lispworks (return *command-line-arguments*)
     4321        ;; On other implementations, on non-standalone executables,
     4322        ;; we trust cl-launch or whichever script starts the program
     4323        ;; to use -- as a delimiter between implementation arguments and user arguments.
     4324        #-lispworks (setf arguments (member "--" arguments :test 'string-equal)))
    43084325      (rest arguments)))
    43094326
     
    43404357Then, comes the restore process itself:
    43414358First, call each function in the RESTORE-HOOK,
    4342 in the order they were registered with REGISTER-RESTORE-HOOK.
     4359in the order they were registered with REGISTER-IMAGE-RESTORE-HOOK.
    43434360Second, evaluate the prelude, which is often Lisp text that is read,
    43444361as per EVAL-INPUT.
     
    43854402                                #+clozure prepend-symbols #+clozure (purify t)
    43864403                                #+sbcl compression
    4387                                 #+(and sbcl windows) application-type)
     4404                                #+(and sbcl os-windows) application-type)
    43884405    "Dump an image of the current Lisp environment at pathname FILENAME, with various options.
    43894406
     
    44594476              ;;--- only save runtime-options for standalone executables
    44604477              (when executable (list :toplevel #'restore-image :save-runtime-options t))
    4461               #+(and sbcl windows) ;; passing :application-type :gui will disable the console window.
     4478              #+(and sbcl os-windows) ;; passing :application-type :gui will disable the console window.
    44624479              ;; the default is :console - only works with SBCL 1.1.15 or later.
    44634480              (when application-type (list :application-type application-type)))))
     
    52965313    (%wait-process-result
    52975314     (apply '%run-program (%normalize-system-command command) :wait t keys))
    5298     #+(or abcl cormanlisp clisp ecl gcl (and lispworks os-windows) mkcl xcl)
     5315    #+(or abcl cormanlisp clisp ecl gcl genera (and lispworks os-windows) mkcl xcl)
    52995316    (let ((%command (%redirected-system-command command input output error-output directory)))
    53005317      #+(and lispworks os-windows)
     
    53135330                (ext:system %command))
    53145331        #+gcl (system:system %command)
     5332        #+genera (error "~S not supported on Genera, cannot run ~S"
     5333                        '%system %command)
    53155334        #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
    53165335        #+mkcl (mkcl:system %command)
     
    63436362be applied to the results to yield a configuration form.  Current
    63446363values of TAG include :source-registry and :output-translations."
    6345     (let ((files (sort (ignore-errors
     6364    (let ((files (sort (ignore-errors ;; SORT w/o COPY-LIST is OK: DIRECTORY returns a fresh list
    63466365                        (remove-if
    63476366                         'hidden-pathname-p
     
    66406659         ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
    66416660         ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
    6642          (asdf-version "3.1.2.2")
     6661         (asdf-version "3.1.2.9")
    66436662         (existing-version (asdf-version)))
    66446663    (setf *asdf-version* asdf-version)
     
    66526671(when-upgrading ()
    66536672  (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops.
    6654     ;; NB: it's too late to do anything about functions in UIOP!
    6655     ;; If you introduce some critically incompatibility there, you must change name.
     6673          ;; NB: it's too late to do anything about functions in UIOP!
     6674          ;; If you introduce some critically incompatibility there, you must change name.
    66566675          '(#:component-relative-pathname #:component-parent-pathname ;; component
    66576676            #:source-file-type
    66586677            #:find-system #:system-source-file #:system-relative-pathname ;; system
    6659       #:find-component ;; find-component
    6660       #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
    6661       #:component-depends-on #:operation-done-p #:component-depends-on
    6662       #:traverse ;; backward-interface
     6678            #:find-component ;; find-component
     6679            #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
     6680            #:component-depends-on #:operation-done-p #:component-depends-on
     6681            #:traverse ;; backward-interface
    66636682            #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan
    6664       #:operate  ;; operate
    6665       #:parse-component-form ;; defsystem
    6666       #:apply-output-translations ;; output-translations
    6667       #:process-output-translations-directive
    6668       #:inherit-source-registry #:process-source-registry ;; source-registry
    6669       #:process-source-registry-directive
    6670       #:trivial-system-p)) ;; bundle
    6671   (redefined-classes
     6683            #:operate  ;; operate
     6684            #:parse-component-form ;; defsystem
     6685            #:apply-output-translations ;; output-translations
     6686            #:process-output-translations-directive
     6687            #:inherit-source-registry #:process-source-registry ;; source-registry
     6688            #:process-source-registry-directive
     6689            #:trivial-system-p)) ;; bundle
     6690        (redefined-classes
    66726691          ;; redefining the classes causes interim circularities
    6673     ;; with the old ASDF during upgrade, and many implementations bork
     6692          ;; with the old ASDF during upgrade, and many implementations bork
    66746693          '((#:compile-concatenated-source-op (#:operation) ()))))
    66756694    (loop :for name :in redefined-functions
     
    66796698              #-clisp (fmakunbound sym)))
    66806699    (labels ((asym (x) (multiple-value-bind (s p) (if (consp x) (values (car x) (cadr x)) (values x :asdf))
    6681       (find-symbol* s p nil)))
    6682        (asyms (l) (mapcar #'asym l)))
     6700                        (find-symbol* s p nil)))
     6701             (asyms (l) (mapcar #'asym l)))
    66836702      (loop* :for (name superclasses slots) :in redefined-classes
    6684        :for sym = (find-symbol* name :asdf nil)
    6685        :when (and sym (find-class sym))
    6686        :do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots)))))))
     6703             :for sym = (find-symbol* name :asdf nil)
     6704             :when (and sym (find-class sym))
     6705             :do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots)))))))
    66876706
    66886707
     
    71457164  (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp
    71467165           #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache
    7147      #:do-asdf-cache #:normalize-namestring
    7148            #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*))
     7166           #:do-asdf-cache #:normalize-namestring
     7167           #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*
     7168           #:clear-configuration-and-retry #:retry))
    71497169(in-package :asdf/cache)
    71507170
     
    71827202      (if (and *asdf-cache* (not override))
    71837203          (funcall fun)
    7184           (let ((*asdf-cache* (make-hash-table :test 'equal)))
    7185             (funcall fun)))))
     7204          (loop
     7205            (restart-case
     7206                (let ((*asdf-cache* (make-hash-table :test 'equal)))
     7207                  (return (funcall fun)))
     7208              (retry ()
     7209                :report (lambda (s)
     7210                          (format s (compatfmt "~@<Retry ASDF operation.~@:>"))))
     7211              (clear-configuration-and-retry ()
     7212                :report (lambda (s)
     7213                          (format s (compatfmt "~@<Retry ASDF operation after resetting the configuration.~@:>")))
     7214                (clear-configuration)))))))
    71867215
    71877216  (defmacro with-asdf-cache ((&key key override) &body body)
     
    73107339    ;; Invalidate all systems but ASDF itself, if registered.
    73117340    (loop :for name :being :the :hash-keys :of *defined-systems*
    7312     :unless (equal name "asdf")
    7313       :do (clear-defined-system name)))
     7341          :unless (equal name "asdf")
     7342            :do (clear-defined-system name)))
    73147343
    73157344  (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)
     
    75647593FOUNDP is true when a system was found,
    75657594either a new unregistered one or a previously registered one.
    7566 FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed as is
    7567 PATHNAME when not null is a path from where to load the system,
     7595FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed.
     7596PATHNAME when not null is a path from which to load the system,
    75687597either associated with FOUND-SYSTEM, or with the PREVIOUS system.
    75697598PREVIOUS when not null is a previously loaded SYSTEM object of same name.
    75707599PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded."
    7571     (with-asdf-cache (:key `(locate-system ,name))
    7572       (let* ((name (coerce-name name))
    7573              (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk
    7574              (previous (cdr in-memory))
    7575              (previous (and (typep previous 'system) previous))
    7576              (previous-time (car in-memory))
    7577              (found (search-for-system-definition name))
    7578              (found-system (and (typep found 'system) found))
    7579              (pathname (ensure-pathname
    7580                         (or (and (typep found '(or pathname string)) (pathname found))
    7581                             (and found-system (system-source-file found-system))
    7582                             (and previous (system-source-file previous)))
    7583                         :want-absolute t :resolve-symlinks *resolve-symlinks*))
    7584              (foundp (and (or found-system pathname previous) t)))
    7585         (check-type found (or null pathname system))
    7586         (unless (check-not-old-asdf-system name pathname)
    7587           (cond
    7588             (previous (setf found nil pathname nil))
    7589             (t
    7590              (setf found (sysdef-preloaded-system-search "asdf"))
    7591              (assert (typep found 'system))
    7592              (setf found-system found pathname nil))))
    7593         (values foundp found-system pathname previous previous-time))))
     7600    (let* ((name (coerce-name name))
     7601           (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk
     7602           (previous (cdr in-memory))
     7603           (previous (and (typep previous 'system) previous))
     7604           (previous-time (car in-memory))
     7605           (found (search-for-system-definition name))
     7606           (found-system (and (typep found 'system) found))
     7607           (pathname (ensure-pathname
     7608                      (or (and (typep found '(or pathname string)) (pathname found))
     7609                          (and found-system (system-source-file found-system))
     7610                          (and previous (system-source-file previous)))
     7611                      :want-absolute t :resolve-symlinks *resolve-symlinks*))
     7612           (foundp (and (or found-system pathname previous) t)))
     7613      (check-type found (or null pathname system))
     7614      (unless (check-not-old-asdf-system name pathname)
     7615        (cond
     7616          (previous (setf found nil pathname nil))
     7617          (t
     7618           (setf found (sysdef-preloaded-system-search "asdf"))
     7619           (assert (typep found 'system))
     7620           (setf found-system found pathname nil))))
     7621      (values foundp found-system pathname previous previous-time)))
    75947622
    75957623  (defmethod find-system ((name string) &optional (error-p t))
     
    75987626        (unless (equal name primary-name)
    75997627          (find-system primary-name nil)))
    7600       (loop
    7601         (restart-case
    7602             (multiple-value-bind (foundp found-system pathname previous previous-time)
    7603                 (locate-system name)
    7604               (when (and found-system (eq found-system previous)
    7605                          (or (first (gethash `(find-system ,name) *asdf-cache*))
    7606                              (and *immutable-systems* (gethash name *immutable-systems*))))
    7607                 (return found-system))
    7608               (assert (eq foundp (and (or found-system pathname previous) t)))
    7609               (let ((previous-pathname (and previous (system-source-file previous)))
    7610                     (system (or previous found-system)))
    7611                 (when (and found-system (not previous))
    7612                   (register-system found-system))
    7613                 (when (and system pathname)
    7614                   (setf (system-source-file system) pathname))
    7615                 (when (and pathname
    7616                            (let ((stamp (get-file-stamp pathname)))
    7617                              (and stamp
    7618                                   (not (and previous
    7619                                             (or (pathname-equal pathname previous-pathname)
    7620                                                 (and pathname previous-pathname
    7621                                                      (pathname-equal
    7622                                                       (physicalize-pathname pathname)
    7623                                                       (physicalize-pathname previous-pathname))))
    7624                                             (stamp<= stamp previous-time))))))
    7625                   ;; only load when it's a pathname that is different or has newer content, and not an old asdf
    7626                   (load-asd pathname :name name)))
    7627               (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed
    7628                 (return
    7629                   (cond
    7630                     (in-memory
    7631                      (when pathname
    7632                        (setf (car in-memory) (get-file-stamp pathname)))
    7633                      (cdr in-memory))
    7634                     (error-p
    7635                      (error 'missing-component :requires name))))))
    7636           (reinitialize-source-registry-and-retry ()
    7637             :report (lambda (s)
    7638                       (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name))
    7639       (unset-asdf-cache-entry `(locate-system ,name))
    7640             (initialize-source-registry)))))))
    7641 
     7628      (or (and *immutable-systems* (gethash name *immutable-systems*)
     7629               (cdr (system-registered-p name)))
     7630          (multiple-value-bind (foundp found-system pathname previous previous-time)
     7631              (locate-system name)
     7632            (assert (eq foundp (and (or found-system pathname previous) t)))
     7633            (let ((previous-pathname (and previous (system-source-file previous)))
     7634                  (system (or previous found-system)))
     7635              (when (and found-system (not previous))
     7636                (register-system found-system))
     7637              (when (and system pathname)
     7638                (setf (system-source-file system) pathname))
     7639              (when (and pathname
     7640                         (let ((stamp (get-file-stamp pathname)))
     7641                           (and stamp
     7642                                (not (and previous
     7643                                          (or (pathname-equal pathname previous-pathname)
     7644                                              (and pathname previous-pathname
     7645                                                   (pathname-equal
     7646                                                    (physicalize-pathname pathname)
     7647                                                    (physicalize-pathname previous-pathname))))
     7648                                          (stamp<= stamp previous-time))))))
     7649                ;; only load when it's a pathname that is different or has newer content, and not an old asdf
     7650                (load-asd pathname :name name)))
     7651            (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed
     7652              (cond
     7653                (in-memory
     7654                 (when pathname
     7655                   (setf (car in-memory) (get-file-stamp pathname)))
     7656                 (cdr in-memory))
     7657                (error-p
     7658                 (error 'missing-component :requires name))
     7659                (t ;; not found: don't keep negative cache, see lp#1335323
     7660                 (unset-asdf-cache-entry `(locate-system ,name))
     7661                 (return-from find-system nil)))))))))
    76427662;;;; -------------------------------------------------------------------------
    76437663;;;; Finding components
     
    77497769                     (eq (missing-required-by c) component)
    77507770                     (equal (missing-requires c) name))))
    7751     (unless (component-parent component)
    7752       (let ((name (coerce-name name)))
    7753         (unset-asdf-cache-entry `(find-system ,name))
    7754         (unset-asdf-cache-entry `(locate-system ,name))))))))
     7771          (unless (component-parent component)
     7772            (let ((name (coerce-name name)))
     7773              (unset-asdf-cache-entry `(find-system ,name))
     7774              (unset-asdf-cache-entry `(locate-system ,name))))))))
    77557775
    77567776
     
    90509070
    90519071  (defmethod component-depends-on ((o prepare-op) (s system))
    9052     `((,*load-system-operation* ,@(component-sideway-dependencies s))))
     9072    (loop :for (o . cs) :in (call-next-method)
     9073          :collect (cons (if (eq o 'load-op) *load-system-operation* o) cs)))
    90539074
    90549075  (defclass build-op (non-propagating-operation) ()
     
    90619082that will load the system in the current image, and its typically LOAD-OP."))
    90629083  (defmethod component-depends-on ((o build-op) (c component))
    9063     `((,(or (component-build-operation c) *load-system-operation*) ,c)))
     9084    `((,(or (component-build-operation c) *load-system-operation*) ,c)
     9085      ,@(call-next-method)))
    90649086
    90659087  (defun make (system &rest keys)
     
    1122411246   #:operation-definition-warning #:operation-definition-error
    1122511247
    11226    #:try-recompiling
     11248   #:try-recompiling ; restarts
    1122711249   #:retry
    11228    #:accept                     ; restarts
     11250   #:accept
    1122911251   #:coerce-entry-to-directory
    1123011252   #:remove-entry-from-registry
     11253   #:clear-configuration-and-retry
     11254
    1123111255
    1123211256   #:*encoding-detection-hook*
     
    1126411288   #:system-source-registry
    1126511289   #:user-source-registry-directory
    11266    #:system-source-registry-directory))
     11290   #:system-source-registry-directory
     11291   ))
    1126711292
    1126811293;;;; ---------------------------------------------------------------------------
Note: See TracChangeset for help on using the changeset viewer.