diff --git a/GNUmakefile b/GNUmakefile index dfd7b7080fbcb20dcde2c177633ddca78595bf78..02c3a8948d9a0580360b06ca1701d12601ee5ae2 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -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. diff --git a/asdf.lisp b/asdf.lisp index fc028d37f1bb91bbb1d2fdf29d2c6abc8209db5d..baf3ff07dffdc33cf28ba6801ae94d3dfc1c7ef1 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -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))) - (cdr in-memory)) - (when error-p (error 'missing-component :requires name))))))) + (cond + (in-memory + (when on-disk + (setf (car in-memory) (safe-file-write-date on-disk))) + (cdr in-memory)) + (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,29 +3428,37 @@ 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) - (missing-component (constantly nil)) - (error (lambda (e) - (format *error-output* "ASDF could not load ~(~A~) because ~A.~%" - name e)))) - (let* ((*verbose-out* (make-broadcast-stream)) - (system (find-system (string-downcase name) nil))) - (when system - (load-system system) - t)))) - (pushnew 'module-provide-asdf - #+abcl sys::*module-provider-functions* - #+clozure ccl:*module-provider-functions* - #+cmu ext:*module-provider-functions* - #+ecl si:*module-provider-functions* - #+sbcl sb-ext:*module-provider-functions*)) +(defun* module-provide-asdf (name) + (handler-bind + ((style-warning #'muffle-warning) + (missing-component (constantly nil)) + (error (lambda (e) + (format *error-output* "ASDF could not load ~(~A~) because ~A.~%" + name e)))) + (let* ((*verbose-out* (make-broadcast-stream)) + (system (find-system (string-downcase name) nil))) + (when system + (load-system system) + t)))) + +#+(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*)))) + ;;;; ------------------------------------------------------------------------- ;;;; Cleanups after hot-upgrade. diff --git a/debian/control b/debian/control index aa4117cefbf627d77d8c211c9a73dca36c96de4f..b925b36e91673f17d1d501aae44c42d41cb96bc3 100644 --- a/debian/control +++ b/debian/control @@ -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 diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 2a1c838f8193782a91509fb187f3779067ec4092..c9195e9a293b2e4b3f527fe587da09b5d3bf6aff 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -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 diff --git a/test/GNUmakefile b/test/GNUmakefile index b18732fc78126c2d03bd5add9e8f27c618096427..f3ab11f308317a0993ddf1db387e1f3e9d8064a9 100644 --- a/test/GNUmakefile +++ b/test/GNUmakefile @@ -18,4 +18,4 @@ clean: FORCE done -FORCE: \ No newline at end of file +FORCE: diff --git a/test/run-tests.sh b/test/run-tests.sh index ec906f8367a8c08f2a17c3aa0c74785090f82776..f6087dc1e95f1291e58d2d3b45d267a5e8f18c36 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -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) diff --git a/test/test-configuration.script b/test/test-configuration.script index a0ec2a8897d9f0777f7e87d8dd6e63e8182f003b..d0e312018b5a705b3310d068bcb8470d0d1573da 100644 --- a/test/test-configuration.script +++ b/test/test-configuration.script @@ -75,6 +75,7 @@ (initialize-source-registry `(:source-registry (:include ,(under-test-directory "conf.d/")) :ignore-inherited-configuration)) +#-abcl ;; disable for ABCL for now. Hmmm. We need a better way to handle "known failures". (assert (equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) (under-test-directory "dir2/bar/baz.lisp")))