Changeset 15546


Ignore:
Timestamp:
02/10/22 16:05:15 (12 months ago)
Author:
Mark Evenson
Message:

Upgrade to asdf-3.3.5.7

Location:
trunk/abcl
Files:
2 edited

Legend:

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

    r15505 r15546  
    6666@titlepage
    6767@title ASDF: Another System Definition Facility
    68 @subtitle Manual for Version 3.3.5
     68@subtitle Manual for Version 3.3.5.7
    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.3.5
     85Manual for Version 3.3.5.7
    8686@end ifnottex
    8787
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r15516 r15546  
    11;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; Package: CL-USER ; buffer-read-only: t; -*-
    2 ;;; This is ASDF 3.3.5.0.3: Another System Definition Facility.
     2;;; This is ASDF 3.3.5.7: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    5858  (error "ASDF requires either System 453 or later or Intel Support 3.87 or later")))))
    5959;;;; ---------------------------------------------------------------------------
    60 ;;;; Handle ASDF package upgrade, including implementation-dependent magic.
     60;;;; ASDF package upgrade, including implementation-dependent magic.
    6161;;
    6262;; See https://bugs.launchpad.net/asdf/+bug/485687
     
    148148
    149149(eval-when (:load-toplevel :compile-toplevel :execute)
    150   (defun find-package* (package-designator &optional (error t))
     150  (deftype package-designator () '(and (or package character string symbol) (satisfies find-package)))
     151  (define-condition no-such-package-error (type-error)
     152    ()
     153    (:default-initargs :expected-type 'package-designator)
     154    (:report (lambda (c s)
     155              (format s "No package named ~a" (string (type-error-datum c))))))
     156
     157  (defmethod package-designator ((c no-such-package-error))
     158    (type-error-datum c))
     159
     160  (defun find-package* (package-designator &optional (errorp t))
     161    "Like CL:FIND-PACKAGE, but by default raises a UIOP:NO-SUCH-PACKAGE-ERROR if the
     162  package is not found."
    151163    (let ((package (find-package package-designator)))
    152164      (cond
    153165        (package package)
    154         (error (error "No package named ~S" (string package-designator)))
     166        (errorp (error 'no-such-package-error :datum package-designator))
    155167        (t nil))))
     168
    156169  (defun find-symbol* (name package-designator &optional (error t))
    157170    "Find a symbol in a package of given string'ified NAME;
     
    456469;;; ensure-package, define-package
    457470(eval-when (:load-toplevel :compile-toplevel :execute)
     471  ;; We already have UIOP:SIMPLE-STYLE-WARNING, but it comes from a later
     472  ;; package.
     473  (define-condition define-package-style-warning
     474      #+sbcl (sb-int:simple-style-warning) #-sbcl (simple-condition style-warning)
     475      ())
    458476  (defun ensure-shadowing-import (name to-package from-package shadowed imported)
    459477    (check-type name string)
     
    808826      ;; handle import-from packages
    809827      (loop :for (p . syms) :in import-from
    810             :for pp = (find-package p) :do
     828            ;; FOR NOW suppress errors in the case where the :import-from
     829            ;; symbol list is empty (used only to establish a dependency by
     830            ;; package-inferred-system users).
     831            :for pp = (find-package* p syms) :do
     832              (when (null pp)
     833                ;; TODO: ASDF 3.4 Change to a full warning.
     834                (warn 'define-package-style-warning
     835                      :format-control "When defining package ~a, attempting to import-from non-existent package ~a. This is deprecated behavior and will be removed from UIOP in the future."
     836                      :format-arguments (list name p)))
    811837              (dolist (sym syms) (ensure-import (symbol-name sym) package pp shadowed imported)))
    812838      ;; handle use-list and mix
     
    868894                         :recycle ',(if recycle-p recycle (cons package nicknames))
    869895                         :mix ',mix :reexport ',reexport :unintern ',unintern
    870                          :local-nicknames ',local-nicknames)))))
     896                         ,@(when local-nicknames
     897                             `(:local-nicknames ',local-nicknames)))))))
    871898
    872899(defmacro define-package (package &rest clauses)
     
    913940(define-package :uiop/package*
    914941  (:use-reexport :uiop/package
    915                  #+package-local-nicknames :uiop/package-local-nicknames))
     942                 #+package-local-nicknames :uiop/package-local-nicknames)
     943  (:import-from :uiop/package
     944                #:define-package-style-warning
     945                #:no-such-package-error
     946                #:package-designator)
     947  (:export #:define-package-style-warning
     948           #:no-such-package-error
     949           #:package-designator))
    916950;;;; -------------------------------------------------------------------------
    917951;;;; Handle compatibility with multiple implementations.
     
    17991833  (:export
    18001834   #:*uiop-version*
    1801    #:parse-version #:unparse-version #:version< #:version<= ;; version support, moved from uiop/utility
     1835   #:parse-version #:unparse-version #:version< #:version<= #:version= ;; version support, moved from uiop/utility
    18021836   #:next-version
    18031837   #:deprecated-function-condition #:deprecated-function-name ;; deprecation control
     
    18081842
    18091843(with-upgradability ()
    1810   (defparameter *uiop-version* "3.3.5.0.3")
     1844  (defparameter *uiop-version* "3.3.5.7")
    18111845
    18121846  (defun unparse-version (version-list)
     
    18581892    "Given two version strings, return T if the second is newer or the same"
    18591893    (not (version< version2 version1))))
     1894
     1895  (defun version= (version1 version2)
     1896    "Given two version strings, return T if the first is newer or the same and
     1897the second is also newer or the same."
     1898    (and (version<= version1 version2)
     1899         (version<= version2 version1)))
    18601900
    18611901
     
    28572897              (t
    28582898               (split-name-type filename)))
    2859           (let* ((directory
    2860                    (unless file-only (cons relative path)))
    2861                  (pathname
    2862                    #-abcl
    2863                    (make-pathname
    2864                     :directory directory
    2865                     :name name :type type
    2866                     :defaults (or #-mcl defaults *nil-pathname*))
    2867                    #+abcl
    2868                    (if (and defaults
    2869                             (ext:pathname-jar-p defaults)
    2870                             (null directory))
    2871                        ;; When DEFAULTS is a jar, it will have the directory we want
    2872                        (make-pathname :name name :type type
    2873                                       :defaults (or defaults *nil-pathname*))
    2874                        (make-pathname :name name :type type
    2875                                       :defaults (or defaults *nil-pathname*)
    2876                                       :directory directory))))
    2877             (apply 'ensure-pathname
    2878                    pathname
    2879                    (remove-plist-keys '(:type :dot-dot :defaults) keys)))))))
     2899            (let* ((directory
     2900                    (unless file-only (cons relative path)))
     2901                   (pathname
     2902                    #-abcl
     2903                    (make-pathname
     2904                     :directory directory
     2905                     :name name :type type
     2906                     :defaults (or #-mcl defaults *nil-pathname*))
     2907                    #+abcl
     2908                    (if (and defaults
     2909                             (ext:pathname-jar-p defaults)
     2910                             (null directory))
     2911                        ;; When DEFAULTS is a jar, it will have the directory we want
     2912                        (make-pathname :name name :type type
     2913                                       :defaults (or defaults *nil-pathname*))
     2914                        (make-pathname :name name :type type
     2915                                       :defaults (or defaults *nil-pathname*)
     2916                                       :directory directory))))
     2917              (apply 'ensure-pathname
     2918                     pathname
     2919                     (remove-plist-keys '(:type :dot-dot :defaults) keys)))))))
    28802920
    28812921  (defun unix-namestring (pathname)
     
    59245964   #:launch-program
    59255965   #:close-streams #:process-alive-p #:terminate-process #:wait-process
     5966   #:process-info
    59265967   #:process-info-error-output #:process-info-input #:process-info-output #:process-info-pid))
    59275968(in-package :uiop/launch-program)
     
    61306171     ;; If the platform allows it, distinguish exiting with a code
    61316172     ;; >128 from exiting in response to a signal by setting this code
    6132      (signal-code :initform nil)))
     6173     (signal-code :initform nil))
     6174    (:documentation "This class should be treated as opaque by programmers, except for the
     6175exported PROCESS-INFO-* functions.  It should never be directly instantiated by
     6176MAKE-INSTANCE. Primarily, it is being made available to enable type-checking."))
    61336177
    61346178;;;---------------------------------------------------------------------------
     
    77877831  ;; Private hook for functions to run after ASDF has upgraded itself from an older variant:
    77887832  (defvar *post-upgrade-cleanup-hook* ())
     7833  ;; Private variable for post upgrade cleanup to communicate if an upgrade has
     7834  ;; actually occured.
     7835  (defvar *asdf-upgraded-p*)
    77897836  ;; Private function to detect whether the current upgrade counts as an incompatible
    77907837  ;; data schema upgrade implying the need to drop data.
     
    78247871         ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
    78257872         ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
    7826          (asdf-version "3.3.5.0.3")
     7873         (asdf-version "3.3.5.7")
    78277874         (existing-version (asdf-version)))
    78287875    (setf *asdf-version* asdf-version)
     
    78847931      (unless (equal old-version new-version)
    78857932        (push new-version *previous-asdf-versions*)
     7933        (when (boundp '*asdf-upgraded-p*)
     7934          (setf *asdf-upgraded-p* t))
    78867935        (when old-version
    78877936          (if (version<= new-version old-version)
     
    79027951   We need do that before we operate on anything that may possibly depend on ASDF."
    79037952    (let ((*load-print* nil)
    7904           (*compile-print* nil))
     7953          (*compile-print* nil)
     7954          (*asdf-upgraded-p* nil))
    79057955      (handler-bind (((or style-warning) #'muffle-warning))
    7906         (symbol-call :asdf :load-system :asdf :verbose nil))))
     7956        (symbol-call :asdf :load-system :asdf :verbose nil))
     7957      *asdf-upgraded-p*))
    79077958
    79087959  (defmacro with-asdf-deprecation ((&rest keys &key &allow-other-keys) &body body)
     
    80488099                :report (lambda (s)
    80498100                          (format s (compatfmt "~@<Retry ASDF operation after resetting the configuration.~@:>")))
    8050                 (clrhash (session-cache *asdf-session*))
     8101                (unless (null *asdf-session*)
     8102                  (clrhash (session-cache *asdf-session*)))
    80518103                (clear-configuration)))))))
    80528104
     
    83698421    ;; TODO: track who uses it in Quicklisp, and have them not use it anymore;
    83708422    ;; maybe issue a WARNING (then eventually CERROR) if the two methods diverge?
    8371     (let ((parent
     8423    (let (#+abcl
     8424          (parent
    83728425            (component-parent-pathname component)))
    83738426      (parse-unix-namestring
     
    83808433       #+abcl (not (ext:pathname-jar-p parent))
    83818434       :type (source-file-type component (component-system component))
    8382        :defaults parent)))
     8435       :defaults (component-parent-pathname component))))
    83838436
    83848437  (defmethod source-file-type ((component parent-component) (system parent-component))
     
    1383113884;;;; Register ASDF itself and all its subsystems as preloaded.
    1383213885(with-upgradability ()
    13833   (dolist (s '("asdf" "uiop" "asdf-package-system"))
     13886  (dolist (s '("asdf" "asdf-package-system"))
    1383413887    ;; Don't bother with these system names, no one relies on them anymore:
    1383513888    ;; "asdf-utils" "asdf-bundle" "asdf-driver" "asdf-defsystem"
    13836     (register-preloaded-system s :version *asdf-version*)))
    13837 
     13889    (register-preloaded-system s :version *asdf-version*))
     13890  (register-preloaded-system "uiop" :version *uiop-version*))
     13891
     13892;;;; Ensure that the version slot on the registered preloaded systems are
     13893;;;; correct, by CLEARing the system. However, we do not CLEAR-SYSTEM
     13894;;;; unconditionally. This is because it's possible the user has upgraded the
     13895;;;; systems using ASDF itself, meaning that the registered systems have real
     13896;;;; data from the file system that we want to preserve instead of blasting
     13897;;;; away and replacing with a blank preloaded system.
     13898(with-upgradability ()
     13899  (unless (equal (system-version (registered-system "asdf")) (asdf-version))
     13900    (clear-system "asdf"))
     13901  ;; 3.1.2 is the last version where asdf-package-system was a separate system.
     13902  (when (version< "3.1.2" (system-version (registered-system "asdf-package-system")))
     13903    (clear-system "asdf-package-system"))
     13904  (unless (equal (system-version (registered-system "uiop")) *uiop-version*)
     13905    (clear-system "uiop")))
    1383813906
    1383913907;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
Note: See TracChangeset for help on using the changeset viewer.