Commit e726bd8b authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Merge branch 'master' into release

parents e1b6c9fd 1f79fcad
Loading
Loading
Loading
Loading
+1 −1
Original line number Diff line number Diff line
@@ -73,7 +73,7 @@ test-all: FORCE
		make test lisp=$$lisp || exit 1 ; \
	done

debian-package:
debian-package: mrproper
	git-buildpackage --git-debian-branch=release --git-upstream-branch=RELEASE --git-tag --git-retag

# Replace SBCL's ASDF with the current one.
+98 −94
Original line number Diff line number Diff line
@@ -48,37 +48,35 @@
#+xcvb (module ())

(cl:in-package :cl)
(defpackage :asdf-bootstrap (:use :cl))
(in-package :asdf-bootstrap)

;; Implementation-dependent tweaks
(eval-when (:compile-toplevel :load-toplevel :execute)
  ;;; make package if it doesn't exist yet.
  ;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it.
  (unless (find-package :asdf)
    (make-package :asdf :use '(:cl)))
  ;;; Implementation-dependent tweaks
  ;; (declaim (optimize (speed 2) (debug 2) (safety 3)) ; NO: rely on the implementation defaults.
  #+allegro
  (setf excl::*autoload-package-name-alist*
        (remove "asdf" excl::*autoload-package-name-alist*
                :test 'equalp :key 'car))
  #+ecl (require :cmp)
  #+gcl
  (eval-when (:compile-toplevel :load-toplevel)
    (defpackage :asdf-utilities (:use :cl))
    (defpackage :asdf (:use :cl :asdf-utilities))))
  #+ecl (require :cmp))

(in-package :asdf)

;;;; Create packages in a way that is compatible with hot-upgrade.
;;;; See https://bugs.launchpad.net/asdf/+bug/485687
;;;; See more at the end of the file.

(eval-when (:load-toplevel :compile-toplevel :execute)
  (defvar *asdf-version* nil)
  (defvar *upgraded-p* nil)
  (let* ((asdf-version ;; the 1+ helps the version bumping script discriminate
          (subseq "VERSION:2.005" (1+ (length "VERSION")))) ; NB: same as 2.120
         (existing-asdf (find-package :asdf))
         (vername '#:*asdf-version*)
         (versym (and existing-asdf
                      (find-symbol (string vername) existing-asdf)))
         (existing-version (and versym (boundp versym) (symbol-value versym)))
          (subseq "VERSION:2.123" (1+ (length "VERSION"))))
         (existing-asdf (fboundp 'find-system))
         (existing-version *asdf-version*)
         (already-there (equal asdf-version existing-version)))
    (unless (and existing-asdf already-there)
      #-gcl
      (when existing-asdf
        (format *trace-output*
                "~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%"
@@ -160,38 +158,9 @@
                   :shadow ',shadow
                   :unintern ',(append #-(or gcl ecl) redefined-functions unintern)
                   :fmakunbound ',(append fmakunbound))))
          (pkgdcl
           :asdf-utilities
           :nicknames (#:asdf-extensions)
           :use (#:common-lisp)
           :unintern (#:split #:make-collector)
           :export
           (#:absolute-pathname-p
            #:aif
            #:appendf
            #:asdf-message
            #:coerce-name
            #:directory-pathname-p
            #:ends-with
            #:ensure-directory-pathname
            #:getenv
            #:get-uid
            #:length=n-p
            #:merge-pathnames*
            #:pathname-directory-pathname
            #:read-file-forms
            #:remove-keys
            #:remove-keyword
            #:resolve-symlinks
            #:split-string
            #:component-name-to-pathname-components
            #:split-name-type
            #:system-registered-p
            #:truenamize
            #:while-collecting))
          (pkgdcl
           :asdf
           :use (:common-lisp :asdf-utilities)
           :use (:common-lisp)
           :redefined-functions
           (#:perform #:explain #:output-files #:operation-done-p
            #:perform-with-restarts #:component-relative-pathname
@@ -208,7 +177,7 @@
           :export
           (#:defsystem #:oos #:operate #:find-system #:run-shell-command
            #:system-definition-pathname #:find-component ; miscellaneous
            #:compile-system #:load-system #:test-system
            #:compile-system #:load-system #:test-system #:clear-system
            #:compile-op #:load-op #:load-source-op
            #:test-op
            #:operation               ; operations
@@ -255,6 +224,7 @@

            #:operation-on-warnings
            #:operation-on-failure
            #:component-visited-p
            ;;#:*component-parent-pathname*
            #:*system-definition-search-functions*
            #:*central-registry*         ; variables
@@ -284,6 +254,7 @@
            #:coerce-entry-to-directory
            #:remove-entry-from-registry

            #:clear-configuration
            #:initialize-output-translations
            #:disable-output-translations
            #:clear-output-translations
@@ -292,28 +263,43 @@
            #:compile-file*
            #:compile-file-pathname*
            #:enable-asdf-binary-locations-compatibility

            #:*default-source-registries*
            #:initialize-source-registry
            #:compute-source-registry
            #:clear-source-registry
            #:ensure-source-registry
            #:process-source-registry)))
        (let* ((version (intern* vername :asdf))
               (upvar (intern* '#:*upgraded-p* :asdf))
               (upval0 (and (boundp upvar) (symbol-value upvar)))
               (upval1 (if existing-version (cons existing-version upval0) upval0)))
          (eval `(progn
                   (defparameter ,version ,asdf-version)
                   (defparameter ,upvar ',upval1))))))))
            #:process-source-registry

(in-package :asdf)
            ;; Utilities
            #:absolute-pathname-p
            #:aif
            #:appendf
            #:asdf-message
            #:coerce-name
            #:directory-pathname-p
            #:ends-with
            #:ensure-directory-pathname
            #:getenv
            #:get-uid
            #:length=n-p
            #:merge-pathnames*
            #:pathname-directory-pathname
            #:read-file-forms
            #:remove-keys
            #:remove-keyword
            #:resolve-symlinks
            #:split-string
            #:component-name-to-pathname-components
            #:split-name-type
            #:system-registered-p
            #:truenamize
            #:while-collecting)))
        (setf *asdf-version* asdf-version
              *upgraded-p* (if existing-version
                               (cons existing-version *upgraded-p*)
                               *upgraded-p*))))))

;; More cleanups in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
#+gcl
(eval-when (:compile-toplevel :load-toplevel)
  (defvar *asdf-version* nil)
  (defvar *upgraded-p* nil))
(when *upgraded-p*
   #+ecl
   (when (find-class 'compile-op nil)
@@ -451,7 +437,10 @@ OPERATION\).
  No evidence that DATA is ever interesting, beyond just being
non-NIL.  Using the data field is probably very risky; if there is
already a record for OPERATION X COMPONENT, DATA will be quietly
discarded instead of recorded."))
discarded instead of recorded.
  Starting with 2.006, TRAVERSE will store an integer in data,
so that nodes can be sorted in decreasing order of traversal."))


(defgeneric* (setf visiting-component) (new-value operation component))

@@ -1231,7 +1220,7 @@ to ~S which is not a directory.~@:>"
  ;; (or should we treat the case in a different, special way?)
  (or (and pathname (probe-file pathname) (file-write-date pathname))
      (progn
        (when pathname
        (when (and pathname *asdf-verbose*)
          (warn "Missing FILE-WRITE-DATE for ~S: treating it as zero."
                pathname))
        0)))
@@ -1260,11 +1249,13 @@ to ~S which is not a directory.~@:>"
                   (load on-disk)))
            (delete-package package))))
      (let ((in-memory (system-registered-p name)))
        (if in-memory
            (progn (when on-disk (setf (car in-memory)
                                       (safe-file-write-date on-disk)))
        (cond
          (in-memory
           (when on-disk
             (setf (car in-memory) (safe-file-write-date on-disk)))
           (cdr in-memory))
            (when error-p (error 'missing-component :requires name)))))))
          (error-p
           (error 'missing-component :requires name)))))))

(defun* register-system (name system)
  (asdf-message "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
@@ -1389,7 +1380,7 @@ to ~S which is not a directory.~@:>"
   ;;   including other systems we depend on.
   ;; (SYSTEM1 SYSTEM2 ... SYSTEMN)
   ;;   to force systems named in a given list
   ;;   (but this feature never worked before ASDF 1.700 and is cerror'ed out.)
   ;; However, but this feature never worked before ASDF 1.700 and is currently cerror'ed out.
   (forced :initform nil :initarg :force :accessor operation-forced)
   (original-initargs :initform nil :initarg :original-initargs
                      :accessor operation-original-initargs)
@@ -1645,6 +1636,8 @@ recursive calls to traverse.")
                          (error "Bad dependency ~a.  Dependencies must be (:version <version>), (:feature <feature> [version]), or a name" d))))))
           flag))))

(defvar *visit-count* 0) ; counter that allows to sort nodes from operation-visited-nodes

(defun* do-collect (collect x)
  (funcall collect x))

@@ -1730,7 +1723,7 @@ recursive calls to traverse.")
                 (do-collect collect (vector module-ops))
                 (do-collect collect (cons operation c)))))
             (setf (visiting-component operation c) nil)))
      (visit-component operation c flag)
      (visit-component operation c (when flag (incf *visit-count*)))
      flag))

(defun* flatten-tree (l)
@@ -1760,7 +1753,8 @@ recursive calls to traverse.")
          (mapcar #'coerce-name (operation-forced operation))))
  (flatten-tree
   (while-collecting (collect)
     (do-traverse operation c #'collect))))
     (let ((*visit-count* 0))
       (do-traverse operation c #'collect)))))

(defmethod perform ((operation operation) (c source-file))
  (sysdef-error
@@ -1821,7 +1815,9 @@ recursive calls to traverse.")
(defmethod perform ((operation compile-op) (c cl-source-file))
  #-:broken-fasl-loader
  (let ((source-file (component-pathname c))
        (output-file (output-file operation c))
        ;; on some implementations, there are more than one output-file,
        ;; but the first one should always be the primary fasl that gets loaded.
        (output-file (first (output-files operation c)))
        (*compile-file-warnings-behaviour* (operation-on-warnings operation))
        (*compile-file-failure-behaviour* (operation-on-failure operation)))
    (multiple-value-bind (output warnings-p failure-p)
@@ -2049,8 +2045,8 @@ recursive calls to traverse.")
                (setf (gethash (type-of op)
                               (component-operation-times component))
                      (get-universal-time))
                (return)))))))
    op))
                (return))))))
      (values op steps))))

(defun* oos (operation-class system &rest args &key force verbose version
            &allow-other-keys)
@@ -2121,7 +2117,7 @@ details."
  (let* ((file-pathname (load-pathname))
         (directory-pathname (and file-pathname (pathname-directory-pathname file-pathname))))
    (or (and pathname-supplied-p (merge-pathnames* pathname directory-pathname))
        file-pathname
        directory-pathname
        (default-directory))))

(defmacro defsystem (name &body options)
@@ -3432,11 +3428,13 @@ with a different configuration, so the configuration would be re-read then."
    :for file = (probe-asd name defaults)
    :when file :return file))

(defun* clear-configuration ()
  (clear-source-registry)
  (clear-output-translations))

;;;; -----------------------------------------------------------------
;;;; Hook into REQUIRE for ABCL, ClozureCL, CMUCL, ECL and SBCL
;;;;
#+(or abcl clozure cmu ecl sbcl)
(progn
(defun* module-provide-asdf (name)
  (handler-bind
      ((style-warning #'muffle-warning)
@@ -3449,12 +3447,18 @@ with a different configuration, so the configuration would be re-read then."
      (when system
        (load-system system)
        t))))
  (pushnew 'module-provide-asdf

#+(or abcl clisp clozure cmu ecl sbcl)
(let ((x (and #+clisp (find-symbol "*MODULE-PROVIDER-FUNCTIONS*" :custom))))
  (when x
    (eval `(pushnew 'module-provide-asdf
            #+abcl sys::*module-provider-functions*
            #+clisp ,x
            #+clozure ccl:*module-provider-functions*
            #+cmu ext:*module-provider-functions*
            #+ecl si:*module-provider-functions*
           #+sbcl sb-ext:*module-provider-functions*))
            #+sbcl sb-ext:*module-provider-functions*))))


;;;; -------------------------------------------------------------------------
;;;; Cleanups after hot-upgrade.
+1 −0
Original line number Diff line number Diff line
@@ -3,6 +3,7 @@ Section: lisp
Priority: optional
Maintainer: Debian Common Lisp Team <pkg-common-lisp-devel@lists.alioth.debian.org>
Uploaders: Peter Van Eynde <pvaneynd@debian.org>,
  Milan Zamazal <pdm@zamazal.org>,
  Francois-Rene Rideau <fare@tunes.org>
Build-Depends: debhelper (>> 7)
Build-Depends-Indep: texinfo, texlive-extra-utils, texlive, texlive-generic-recommended
+3 −2
Original line number Diff line number Diff line
@@ -554,7 +554,8 @@ by evaluating the following Lisp form:
(asdf:load-system :@var{foo})
@end example

On some implementations (namely ABCL, Clozure CL, CMUCL, ECL and SBCL),
On some implementations (namely recent versions of
ABCL, Clozure CL, CLISP, CMUCL, ECL, SBCL and SCL),
ASDF hooks into the @code{CL:REQUIRE} facility
and you can just use:

@@ -2900,7 +2901,7 @@ if you allow such configuration.
@item
If your system provides a mechanism to hook into @code{CL:REQUIRE},
then it would be nice to add ASDF to this hook the same way that
ABCL, CCL, CMUCL, ECL and SBCL do it.
ABCL, CCL, CLISP, CMUCL, ECL, SBCL and SCL do it.

@item
You may, like SBCL, have ASDF be implicitly used to require systems
+1 −5
Original line number Diff line number Diff line
@@ -41,7 +41,7 @@ if [ x"$1" = "xhelp" ]; then
    usage
    exit 1
fi
lisp=$1 ; shift
lisp=${1:-sbcl} ; shift

if [ -z "$*" ]; then
    scripts="*.script"
@@ -99,10 +99,6 @@ do_tests() {
# terminate on error
set -e

if [ -z $1 ] ; then
    lisp="sbcl"
fi

command= flags= nodebug= eval=
case "$lisp" in
  abcl)
Loading