Changeset 14604

Timestamp:

01/16/14 17:54:38 (8 years ago)

Author:

Mark Evenson

Message:

Update to asdf-3.1.0.49.

Location:

trunk/abcl

Files:

• doc/asdf/asdf.texinfo (modified) (2 diffs)
• src/org/armedbear/lisp/asdf.lisp (modified) (29 diffs)

trunk/abcl/doc/asdf/asdf.texinfo

@@ -4297 +4297 @@
 You may consult with the maintainer for which specific version they recommend,
 but the latest @code{release} should be correct.
-We trust you to thoroughly test it with your implementation
+Though we do try to test ASDF releases against all implementations that we can,
+we may not be testing against all variants of your implementation,
+and we may not be running enough tetst;
+we trust you to thoroughly test it with your own implementation
 before you release it.
 If there are any issues with the current release,
@@ -4351 +4354 @@
 Non-magic systems should be at the back of the @code{wrapping-source-registry}
 while magic systems are at the front.
+
+@item
+Since ASDF 3, the library UIOP comes transcluded in ASDF.
+But for extra brownies, you may package UIOP separately,
+so that one may @code{(require "uiop")} and not pull ASDF,
+or one may @code{(require "asdf")}
+and that would implicitly require the former.
 
 @item

trunk/abcl/src/org/armedbear/lisp/asdf.lisp

@@ -1 +1 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
-;;; This is ASDF 3.1.0.36: Another System Definition Facility.
+;;; This is ASDF 3.1.0.49: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
@@ -20 +20 @@
 ;;;  Monday; July 13, 2009)
 ;;;
-;;; Copyright (c) 2001-2012 Daniel Barlow and contributors
+;;; Copyright (c) 2001-2014 Daniel Barlow and contributors
 ;;;
 ;;; Permission is hereby granted, free of charge, to any person obtaining
@@ -52 +52 @@
 #+cmu
 (eval-when (:load-toplevel :compile-toplevel :execute)
-  (declaim (optimize (speed 1) (safety 3) (debug 3)))
   (setf ext:*gc-verbose* nil))
 
-#+(or abcl clozure cmu ecl xcl) ;; punt on hard package upgrade on those implementations
+;; Punt on hard package upgrade: from ASDF1 always, and even from ASDF2 on most implementations.
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (unless (member :asdf3 *features*)
@@ -72 +71 @@
            (away (format nil "~A-~A" :asdf existing-version)))
       (when (and existing-version
-                 (< existing-version-number 2.27))
+                 (< existing-version-number
+        (or #+(or allegro clisp lispworks sbcl) 2.0 2.27)))
         (rename-package :asdf away)
         (when *load-verbose*
@@ -562 +562 @@
             (t
              (ensure-inherited name symbol to-package from-package t shadowed imported inherited)))))))
-  
+
   (defun recycle-symbol (name recycle exported)
     ;; Takes a symbol NAME (a string), a list of package designators for RECYCLE
@@ -787 +787 @@
 
 (defmacro define-package (package &rest clauses)
-  "DEFINE-PACKAGE takes a PACKAGE and a number of CLAUSES, of the form 
+  "DEFINE-PACKAGE takes a PACKAGE and a number of CLAUSES, of the form
 \(KEYWORD . ARGS\).
 DEFINE-PACKAGE supports the following keywords:
@@ -801 +801 @@
 created again. In short, except for special cases, always make it the first
 package on the list if the list is not empty.
-MIX -- Takes a list of package designators.  MIX behaves like 
+MIX -- Takes a list of package designators.  MIX behaves like
 \(:USE PKG1 PKG2 ... PKGn\) but additionally uses :SHADOWING-IMPORT-FROM to
 resolve conflicts in favor of the first found symbol.  It may still yield
@@ -1449 +1449 @@
 (with-upgradability ()
   (defun ensure-gethash (key table default)
-    "Lookup the TABLE for a KEY as by gethash, but if not present,
+    "Lookup the TABLE for a KEY as by GETHASH, but if not present,
 call the (possibly constant) function designated by DEFAULT as per CALL-FUNCTION,
-set the corresponding entry to the result in the table, and return that result."
+set the corresponding entry to the result in the table.
+Return two values: the entry after its optional computation, and whether it was found"
     (multiple-value-bind (value foundp) (gethash key table)
-      (if foundp
-          value
-          (setf (gethash key table) (values (call-function default))))))
+      (values
+       (if foundp
+           value
+           (setf (gethash key table) (call-function default)))
+       foundp)))
 
   (defun list-to-hash-set (list &aux (h (make-hash-table :test 'equal)))
@@ -4277 +4280 @@
                                 (dump-hook *image-dump-hook*)
                                 #+clozure prepend-symbols #+clozure (purify t)
+                                #+sbcl compression
                                 #+(and sbcl windows) application-type)
     "Dump an image of the current Lisp environment at pathname FILENAME, with various options"
@@ -4339 +4343 @@
       (apply 'sb-ext:save-lisp-and-die filename
              :executable t ;--- always include the runtime that goes with the core
-             (when executable (list :toplevel #'restore-image :save-runtime-options t)) ;--- only save runtime-options for standalone executables
-             #+(and sbcl windows) ;; passing :application-type :gui will disable the console window.
-             ;; the default is :console - only works with SBCL 1.1.15 or later.
-             (when application-type (list :application-type application-type))))
+             (append
+              (when compression (list :compression compression))
+              ;;--- only save runtime-options for standalone executables
+              (when executable (list :toplevel #'restore-image :save-runtime-options t))
+              #+(and sbcl windows) ;; passing :application-type :gui will disable the console window.
+              ;; the default is :console - only works with SBCL 1.1.15 or later.
+              (when application-type (list :application-type application-type)))))
     #-(or allegro clisp clozure cmu gcl lispworks sbcl scl)
     (error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%"
@@ -4964 +4971 @@
             #+(or cmu scl) (ext:process-exit-code process)
             #+ecl (nth-value 1 (ext:external-process-status process))
-            #+lispworks (system:pid-exit-status process :wait t)
+            #+lispworks
+            (if-let ((stream (or (getf process-info :input-stream)
+                                 (getf process-info :output-stream)
+                                 (getf process-info :bidir-stream)
+                                 (getf process-info :error-stream))))
+              (system:pipe-exit-status stream :wait t)
+              (if-let ((f (find-symbol* :pid-exit-status :system nil)))
+                (funcall f process :wait t)))
             #+sbcl (sb-ext:process-exit-code process)))))
 
@@ -6436 +6450 @@
   (defvar *asdf-version* nil)
   ;; We need to clear systems from versions yet older than the below:
-  (defparameter *oldest-forward-compatible-asdf-version* "2.27")
+  (defparameter *oldest-forward-compatible-asdf-version* "2.33") ;; 2.32.13 renames a slot in component.
   (defmacro defparameter* (var value &optional docstring)
     (let* ((name (string-trim "*" var))
@@ -6467 +6481 @@
          ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
          ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
-         (asdf-version "3.1.0.36")
+         (asdf-version "3.1.0.49")
          (existing-version (asdf-version)))
     (setf *asdf-version* asdf-version)
@@ -7356 +7370 @@
                              (read-file-form version-pathname)))
                (old-version (asdf-version)))
-          (or (version<= old-version version)
-              (ensure-gethash
-               (list pathname old-version) *old-asdf-systems*
-                 #'(lambda ()
-                     (let ((old-pathname
-                             (if-let (pair (system-registered-p "asdf"))
-                               (system-source-file (cdr pair)))))
-                       (warn "~@<~
+          (cond
+            ((version< old-version version) t) ;; newer version: good!
+            ((equal old-version version) nil) ;; same version: don't load, but don't warn
+            (t ;; old version: bad
+             (ensure-gethash
+              (list (namestring pathname) version) *old-asdf-systems*
+              #'(lambda ()
+                 (let ((old-pathname
+                         (if-let (pair (system-registered-p "asdf"))
+                           (system-source-file (cdr pair)))))
+                   (warn "~@<~
         You are using ASDF version ~A ~:[(probably from (require \"asdf\") ~
         or loaded by quicklisp)~;from ~:*~S~] and have an older version of ASDF ~
@@ -7385 +7402 @@
         or use :ignore-inherited-configuration to avoid registering the old one. ~
         Please consult ASDF documentation and/or experts.~@:>~%"
-                             old-version old-pathname version pathname)
-                       t)))))))
+                         old-version old-pathname version pathname))))
+             nil))))) ;; only issue the warning the first time, but always return nil
 
   (defun locate-system (name)
@@ -7676 +7693 @@
 (in-package :asdf/action)
 
-(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
-  (deftype action () '(cons operation component))) ;; a step to be performed while building
+(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) ;; LispWorks issues spurious warning
+  (deftype action () '(cons operation component)) ;; a step to be performed while building
+
+  (deftype operation-designator ()
+    ;; an operation designates itself,
+    ;; nil designates a context-dependent current operation, and
+    ;; class-name or class designates an instance of the designated class.
+    '(or operation null symbol class)))
 
 (with-upgradability ()
@@ -7781 +7804 @@
 
 
-;;;; upward-operation, downward-operation
-;; These together handle actions that propagate along the component hierarchy.
-;; Downward operations like load-op or compile-op propagate down the hierarchy:
-;; operation on a parent depends-on operation on its children.
-;; By default, an operation propagates itself, but it may propagate another one instead.
+;;;; upward-operation, downward-operation, sideway-operation, selfward-operation
+;; These together handle actions that propagate along the component hierarchy or operation universe.
 (with-upgradability ()
   (defclass downward-operation (operation)
     ((downward-operation
-      :initform nil :initarg :downward-operation :reader downward-operation :allocation :class)))
+      :initform nil :reader downward-operation
+      :type operation-designator :allocation :class))
+    (:documentation "A DOWNWARD-OPERATION's dependencies propagate down the component hierarchy.
+I.e., if O is a DOWNWARD-OPERATION and its DOWNWARD-OPERATION slot designates operation D, then
+the action (O . M) of O on module M will depends on each of (D . C) for each child C of module M.
+The default value for slot DOWNWARD-OPERATION is NIL, which designates the operation O itself.
+E.g. in order for a MODULE to be loaded with LOAD-OP (resp. compiled with COMPILE-OP), all the
+children of the MODULE must have been loaded with LOAD-OP (resp. compiled with COMPILE-OP."))
   (defmethod component-depends-on ((o downward-operation) (c parent-component))
     `((,(or (downward-operation o) o) ,@(component-children c)) ,@(call-next-method)))
-  ;; Upward operations like prepare-op propagate up the component hierarchy:
-  ;; operation on a child depends-on operation on its parent.
-  ;; By default, an operation propagates itself, but it may propagate another one instead.
+
   (defclass upward-operation (operation)
     ((upward-operation
-      :initform nil :initarg :downward-operation :reader upward-operation :allocation :class)))
+      :initform nil :reader upward-operation
+      :type operation-designator :allocation :class))
+    (:documentation "An UPWARD-OPERATION has dependencies that propagate up the component hierarchy.
+I.e., if O is an instance of UPWARD-OPERATION, and its UPWARD-OPERATION slot designates operation U,
+then the action (O . C) of O on a component C that has the parent P will depends on (U . P).
+The default value for slot UPWARD-OPERATION is NIL, which designates the operation O itself.
+E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPARE-OP, its PARENT
+must first be prepared for loading or compiling with PREPARE-OP."))
   ;; For backward-compatibility reasons, a system inherits from module and is a child-component
   ;; so we must guard against this case. ASDF4: remove that.
@@ -7803 +7835 @@
     `(,@(if-let (p (component-parent c))
           `((,(or (upward-operation o) o) ,p))) ,@(call-next-method)))
-  ;; Sibling operations propagate to siblings in the component hierarchy:
-  ;; operation on a child depends-on operation on its parent.
-  ;; By default, an operation propagates itself, but it may propagate another one instead.
+
   (defclass sideway-operation (operation)
     ((sideway-operation
-      :initform nil :initarg :sideway-operation :reader sideway-operation :allocation :class)))
+      :initform nil :reader sideway-operation
+      :type operation-designator :allocation :class))
+    (:documentation "A SIDEWAY-OPERATION has dependencies that propagate \"sideway\" to siblings
+that a component depends on. I.e. if O is a SIDEWAY-OPERATION, and its SIDEWAY-OPERATION slot
+designates operation S (where NIL designates O itself), then the action (O . C) of O on component C
+depends on each of (S . D) where D is a declared dependency of C.
+E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPARE-OP,
+each of its declared dependencies must first be loaded as by LOAD-OP."))
   (defmethod component-depends-on ((o sideway-operation) (c component))
     `((,(or (sideway-operation o) o)
@@ -7814 +7851 @@
                :collect (resolve-dependency-spec c dep)))
       ,@(call-next-method)))
-  ;; Selfward operations propagate to themselves a sub-operation:
-  ;; they depend on some other operation being acted on the same component.
+
   (defclass selfward-operation (operation)
     ((selfward-operation
-      :initform nil :initarg :selfward-operation :reader selfward-operation :allocation :class)))
+      ;; NB: no :initform -- if an operation depends on others, it must explicitly specify which
+      :type (or operation-designator list) :reader selfward-operation :allocation :class))
+    (:documentation "A SELFWARD-OPERATION depends on another operation on the same component.
+I.e., if O is a SELFWARD-OPERATION, and its SELFWARD-OPERATION designates a list of operations L,
+then the action (O . C) of O on component C depends on each (S . C) for S in L.
+A operation-designator designates a singleton list of the designated operation;
+a list of operation-designators designates the list of designated operations;
+NIL is not a valid operation designator in that context.
+E.g. before a component may be loaded by LOAD-OP, it must have been compiled by COMPILE-OP."))
   (defmethod component-depends-on ((o selfward-operation) (c component))
     `(,@(loop :for op :in (ensure-list (selfward-operation o))
@@ -8012 +8056 @@
 (with-upgradability ()
   (defclass prepare-op (upward-operation sideway-operation)
-    ((sideway-operation :initform 'load-op)))
+    ((sideway-operation :initform 'load-op :allocation :class)))
   (defclass load-op (basic-load-op downward-operation sideway-operation selfward-operation)
     ;; NB: even though compile-op depends on prepare-op it is not needed-in-image-p,
     ;; so we need to directly depend on prepare-op for its side-effects in the current image.
-    ((selfward-operation :initform '(prepare-op compile-op))))
+    ((selfward-operation :initform '(prepare-op compile-op) :allocation :class)))
   (defclass compile-op (basic-compile-op downward-operation selfward-operation)
-    ((selfward-operation :initform 'prepare-op)
-     (downward-operation :initform 'load-op)))
+    ((selfward-operation :initform 'prepare-op :allocation :class)
+     (downward-operation :initform 'load-op :allocation :class)))
 
   (defclass prepare-source-op (upward-operation sideway-operation)
-    ((sideway-operation :initform 'load-source-op)))
+    ((sideway-operation :initform 'load-source-op :allocation :class)))
   (defclass load-source-op (basic-load-op downward-operation selfward-operation)
-    ((selfward-operation :initform 'prepare-source-op)))
+    ((selfward-operation :initform 'prepare-source-op :allocation :class)))
 
   (defclass test-op (selfward-operation)
-    ((selfward-operation :initform 'load-op))))
+    ((selfward-operation :initform 'load-op :allocation :class))))
 
 
@@ -9885 +9929 @@
     ((bundle-type :initform :fasl)))
   (defclass prepare-fasl-op (sideway-operation)
-    ((sideway-operation :initform 'load-fasl-op)))
+    ((sideway-operation :initform 'load-fasl-op :allocation :class)))
   (defclass fasl-op (basic-fasl-op selfward-operation)
-    ((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op))))
+    ((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op) :allocation :class)))
   (defclass load-fasl-op (basic-load-op selfward-operation)
-    ((selfward-operation :initform '(prepare-op fasl-op))))
+    ((selfward-operation :initform '(prepare-op fasl-op) :allocation :class)))
 
   ;; NB: since the monolithic-op's can't be sideway-operation's,
@@ -9903 +9947 @@
      #-(or ecl mkcl) "just compile the system"))
 
-  (defclass dll-op (bundle-compile-op selfward-operation no-ld-flags-op)
+  (defclass dll-op (bundle-compile-op no-ld-flags-op)
     ((bundle-type :initform :dll))
     (:documentation "compile the system and produce dynamic (.so/.dll) library for it."))
 
   (defclass binary-op (basic-compile-op selfward-operation)
-    ((selfward-operation :initform '(fasl-op lib-op)))
+    ((selfward-operation :initform '(fasl-op lib-op) :allocation :class))
     (:documentation "produce fasl and asd files for the system"))
 
@@ -9922 +9966 @@
 
   (defclass monolithic-binary-op (monolithic-op binary-op)
-    ((selfward-operation :initform '(monolithic-fasl-op monolithic-lib-op)))
+    ((selfward-operation :initform '(monolithic-fasl-op monolithic-lib-op) :allocation :class))
     (:documentation "produce fasl and asd files for combined system and dependencies."))
 
@@ -10369 +10413 @@
   (defclass concatenate-source-op (basic-concatenate-source-op) ())
   (defclass load-concatenated-source-op (basic-load-concatenated-source-op)
-    ((selfward-operation :initform '(prepare-op concatenate-source-op))))
+    ((selfward-operation :initform '(prepare-op concatenate-source-op) :allocation :class)))
   (defclass compile-concatenated-source-op (basic-compile-concatenated-source-op)
-    ((selfward-operation :initform '(prepare-op concatenate-source-op))))
+    ((selfward-operation :initform '(prepare-op concatenate-source-op) :allocation :class)))
   (defclass load-compiled-concatenated-source-op (basic-load-compiled-concatenated-source-op)
-    ((selfward-operation :initform '(prepare-op compile-concatenated-source-op))))
+    ((selfward-operation :initform '(prepare-op compile-concatenated-source-op) :allocation :class)))
 
   (defclass monolithic-concatenate-source-op (basic-concatenate-source-op monolithic-bundle-op) ())
   (defclass monolithic-load-concatenated-source-op (basic-load-concatenated-source-op)
-    ((selfward-operation :initform 'monolithic-concatenate-source-op)))
+    ((selfward-operation :initform 'monolithic-concatenate-source-op :allocation :class)))
   (defclass monolithic-compile-concatenated-source-op (basic-compile-concatenated-source-op)
-    ((selfward-operation :initform 'monolithic-concatenate-source-op)))
+    ((selfward-operation :initform 'monolithic-concatenate-source-op :allocation :class)))
   (defclass monolithic-load-compiled-concatenated-source-op (basic-load-compiled-concatenated-source-op)
-    ((selfward-operation :initform 'monolithic-compile-concatenated-source-op)))
+    ((selfward-operation :initform 'monolithic-compile-concatenated-source-op :allocation :class)))
 
   (defmethod input-files ((operation basic-concatenate-source-op) (s system))
@@ -10636 +10680 @@
 
   (defun file-defpackage-form (file)
+    "Return the first DEFPACKAGE form in FILE."
     (with-input-file (f file)
       (stream-defpackage-form f)))
@@ -10648 +10693 @@
 
   (defun package-dependencies (defpackage-form)
+    "Return a list of packages depended on by the package
+defined in DEFPACKAGE-FORM.  A package is depended upon if
+the DEFPACKAGE-FORM uses it or imports a symbol from it."
     (assert (defpackage-form-p defpackage-form))
     (remove-duplicates
@@ -10667 +10715 @@
 
   (defun register-system-packages (system packages)
+    "Register SYSTEM as providing PACKAGES."
     (let ((name (or (eq system t) (coerce-name system))))
       (dolist (p (ensure-list packages))
@@ -10672 +10721 @@
 
   (defun package-name-system (package-name)
+    "Return the name of the SYSTEM providing PACKAGE-NAME, if such exists,
+otherwise return a default system name computed from PACKAGE-NAME."
     (check-type package-name string)
     (if-let ((system-name (gethash package-name *package-systems*)))
@@ -10738 +10789 @@
   ;; TODO: automatically generate interface with reexport?
   (:export
-   #:defsystem #:find-system #:locate-system #:coerce-name
+   #:defsystem #:find-system #:locate-system #:coerce-name #:primary-system-name
    #:oos #:operate #:make-plan #:perform-plan #:sequential-plan
    #:system-definition-pathname #:with-system-definitions