diff --git a/GNUmakefile b/GNUmakefile index ad952fd3640fe18a4db9b2cca9cf7287547c48d7..09265ac28495725268a5c3ffd8a1840523d71f88 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -7,11 +7,12 @@ clnet_home := "/project/asdf/public_html/" sourceDirectory := $(shell pwd) -lisps = allegro allegromodern ccl clisp sbcl +lisps ?= allegro ccl clisp ecl lispworks sbcl +## untested by me: abcl allegromodern cmucl +## FAIL: gclcvs +## maybe supported by asdf, never supported by our tests: cormancl mcl scl -ifndef lisp -lisp := sbcl -endif +lisp ?= sbcl # website, tag, install @@ -54,13 +55,11 @@ clean: FORCE make -C doc clean test: FORCE - @cd test; make clean;./run-tests.sh $(lisp) $(test-regex) + @cd test; make clean;./run-tests.sh ${lisp} ${test-glob} test-all: FORCE - @for lisp in $(lisps); do \ - make test lisp=$$lisp; \ + @for lisp in ${lisps} ; do \ + make test lisp=$$lisp || exit 1 ; \ done - sbcl --userinit /dev/null --sysinit /dev/null --load bin/make-helper.lisp \ - --eval "(write-test-web-pages)" --eval "(quit)" FORCE: diff --git a/asdf.lisp b/asdf.lisp index 118b0ff6629d512a95e552b5c4409597374592d9..5d6b13ff62ae763d7de1306d2b42ddc80ead2200 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -63,7 +63,7 @@ (remove "asdf" excl::*autoload-package-name-alist* :test 'equalp :key 'car)) (let* ((asdf-version ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace - (subseq "VERSION:1.712" (1+ (length "VERSION")))) + (subseq "VERSION:1.713" (1+ (length "VERSION")))) (existing-asdf (find-package :asdf)) (versym '#:*asdf-version*) (existing-version (and existing-asdf @@ -72,8 +72,9 @@ (redefined-functions '(#:perform #:explain #:output-files #:operation-done-p #:perform-with-restarts #:component-relative-pathname - #:system-source-file #:operate))) - (unless (equal asdf-version existing-version) + #:system-source-file #:operate)) + (already-there (equal asdf-version existing-version))) + (unless (and existing-asdf already-there) (when existing-asdf (format *error-output* "~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%" @@ -107,6 +108,8 @@ (make-package name :nicknames nicknames :use use))))) (find-sym (symbol package) (find-symbol (string symbol) package)) + (intern* (symbol package) + (intern (string symbol) package)) (remove-symbol (symbol package) (let ((sym (find-sym symbol package))) (when sym @@ -128,7 +131,7 @@ :when sym :do (fmakunbound sym))) (ensure-export (package export) (let ((syms (loop :for x :in export :collect - (intern (string x) package)))) + (intern* x package)))) (do-external-symbols (sym package) (unless (member sym syms) (remove-symbol sym package))) @@ -174,10 +177,10 @@ (ensure-package ':asdf :use '(:common-lisp :asdf-utilities) - :unintern `(#-ecl ,@redefined-functions + :unintern `(#-(or gcl ecl) ,@redefined-functions #:*asdf-revision* #:around #:asdf-method-combination #:split #:make-collector) - :fmakunbound `(#+ecl ,@redefined-functions + :fmakunbound `(#+(or gcl ecl) ,@redefined-functions #:system-source-file #:component-relative-pathname #:system-relative-pathname #:process-source-registry @@ -275,11 +278,31 @@ #:clear-source-registry #:ensure-source-registry #:process-source-registry)) - (eval `(defparameter ,(intern (string versym) (find-package :asdf)) - ,asdf-version)))))) + (let* ((version (intern* versym :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)))))))) (in-package :asdf) +;; More cleanups in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687 +(when *upgraded-p* + #+ecl + (defmethod update-instance-for-redefined-class :after + ((c compile-op) added deleted plist &key) + (declare (ignore added deleted)) + (let ((system-p (getf plist 'system-p))) + (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))) + (eval + '(defmethod update-instance-for-redefined-class :after + ((m module) added deleted plist &key) + (declare (ignorable deleted plist)) + (when (member 'components-by-name added) + (compute-module-components-by-name m))))) + ;;;; ------------------------------------------------------------------------- ;;;; User-visible parameters ;;;; @@ -322,6 +345,7 @@ Defaults to `t`.") (defgeneric explain (operation component)) (defgeneric output-files (operation component)) (defgeneric input-files (operation component)) +(defgeneric component-operation-time (operation component)) (defgeneric system-source-file (system) (:documentation "Return the source file in which system is defined.")) @@ -851,15 +875,6 @@ actually-existing directory." :do (setf (gethash name (module-components-by-name module)) c)) hash)) -;; Cleanup before hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687 -(when (find-class 'module nil) - (eval - '(defmethod update-instance-for-redefined-class :after - ((m module) added deleted plist &key) - (declare (ignore deleted plist)) - (when (member 'components-by-name added) - (compute-module-components-by-name m))))) - (defclass module (component) ((components :initform nil @@ -1140,8 +1155,11 @@ to `~a` which is not a directory.~@:>" (defclass html-file (doc-file) ((type :initform "html"))) -(defmethod source-file-type ((component module) (s module)) :directory) +(defmethod source-file-type ((component module) (s module)) + (declare (ignorable component s)) + :directory) (defmethod source-file-type ((component source-file) (s module)) + (declare (ignorable s)) (source-file-explicit-type component)) (defun merge-component-name-type (name &key type defaults) @@ -1301,12 +1319,17 @@ class specifier, not an operation." ;; original source file, then (list (component-pathname c))))) -(defmethod input-files ((operation operation) (c module)) nil) +(defmethod input-files ((operation operation) (c module)) + (declare (ignorable operation c)) + nil) + +(defmethod component-operation-time (o c) + (gethash (type-of o) (component-operation-times c))) (defmethod operation-done-p ((o operation) (c component)) (let ((out-files (output-files o c)) (in-files (input-files o c)) - (op-time (gethash (type-of o) (component-operation-times c)))) + (op-time (component-operation-time o c))) (flet ((earliest-out () (reduce #'min (mapcar #'safe-file-write-date out-files))) (latest-in () @@ -1569,6 +1592,7 @@ recursive calls to traverse.") (class-of operation) (class-of c))) (defmethod perform ((operation operation) (c module)) + (declare (ignorable operation c)) nil) (defmethod explain ((operation operation) (component component)) @@ -1577,14 +1601,6 @@ recursive calls to traverse.") ;;;; ------------------------------------------------------------------------- ;;;; compile-op -;; Cleanup before hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687 -#+ecl -(when (find-class 'compile-op nil) - (defmethod update-instance-for-redefined-class :after - ((c compile-op) added deleted plist &key) - (let ((system-p (getf plist 'system-p))) - (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p))))) - (defclass compile-op (operation) ((proclamations :initarg :proclamations :accessor compile-op-proclamations :initform nil) (on-warnings :initarg :on-warnings :accessor operation-on-warnings @@ -1636,6 +1652,7 @@ recursive calls to traverse.") (error 'compile-error :component c :operation operation))))) (defmethod output-files ((operation compile-op) (c cl-source-file)) + (declare (ignorable operation)) (let ((p (lispize-pathname (component-pathname c)))) #-:broken-fasl-loader (list #-ecl (compile-file-pathname p) @@ -1644,12 +1661,15 @@ recursive calls to traverse.") #+:broken-fasl-loader (list p))) (defmethod perform ((operation compile-op) (c static-file)) + (declare (ignorable operation c)) nil) (defmethod output-files ((operation compile-op) (c static-file)) + (declare (ignorable operation c)) nil) -(defmethod input-files ((op compile-op) (c static-file)) +(defmethod input-files ((operation compile-op) (c static-file)) + (declare (ignorable operation c)) nil) @@ -1671,6 +1691,7 @@ recursive calls to traverse.") (perform operation component)) (defmethod perform-with-restarts ((o load-op) (c cl-source-file)) + (declare (ignorable o)) (loop :with state = :initial :until (or (eq state :success) (eq state :failure)) :do @@ -1711,15 +1732,19 @@ recursive calls to traverse.") (setf state :success)))))) (defmethod perform ((operation load-op) (c static-file)) + (declare (ignorable operation c)) nil) (defmethod operation-done-p ((operation load-op) (c static-file)) + (declare (ignorable operation c)) t) -(defmethod output-files ((o operation) (c component)) +(defmethod output-files ((operation operation) (c component)) + (declare (ignorable operation c)) nil) (defmethod component-depends-on ((operation load-op) (c component)) + (declare (ignorable operation)) (cons (list 'compile-op (component-name c)) (call-next-method))) @@ -1729,19 +1754,23 @@ recursive calls to traverse.") (defclass load-source-op (basic-load-op) ()) (defmethod perform ((o load-source-op) (c cl-source-file)) + (declare (ignorable o)) (let ((source (component-pathname c))) (setf (component-property c 'last-loaded-as-source) (and (load source) (get-universal-time))))) (defmethod perform ((operation load-source-op) (c static-file)) + (declare (ignorable operation c)) nil) (defmethod output-files ((operation load-source-op) (c component)) + (declare (ignorable operation c)) nil) ;;; FIXME: we simply copy load-op's dependencies. this is Just Not Right. (defmethod component-depends-on ((o load-source-op) (c component)) + (declare (ignorable o)) (let ((what-would-load-op-do (cdr (assoc 'load-op (component-in-order-to c))))) (mapcar (lambda (dep) @@ -1751,6 +1780,7 @@ recursive calls to traverse.") what-would-load-op-do))) (defmethod operation-done-p ((o load-source-op) (c source-file)) + (declare (ignorable o)) (if (or (not (component-property c 'last-loaded-as-source)) (> (safe-file-write-date (component-pathname c)) (component-property c 'last-loaded-as-source))) @@ -1763,13 +1793,16 @@ recursive calls to traverse.") (defclass test-op (operation) ()) (defmethod perform ((operation test-op) (c component)) + (declare (ignorable operation c)) nil) (defmethod operation-done-p ((operation test-op) (c system)) "Testing a system is _never_ done." + (declare (ignorable operation c)) nil) (defmethod component-depends-on :around ((o test-op) (c system)) + (declare (ignorable o)) (cons `(load-op ,(component-name c)) (call-next-method))) diff --git a/test/compile-asdf.lisp b/test/compile-asdf.lisp index 3285c7c2ebb74a63817fb81604c078a9735285df..f379dece5c8beafe9670fef320dbf6a53eb8869f 100644 --- a/test/compile-asdf.lisp +++ b/test/compile-asdf.lisp @@ -18,18 +18,14 @@ #'(lambda (w) (princ w *error-output*) (muffle-warning w)))) - (compile-file *asdf-lisp* :output-file tmp)) + (compile-file *asdf-lisp* :output-file tmp :print t :verbose t)) (declare (ignore result)) (cond - #-ecl (warnings-p (leave-lisp "Testsuite failed: ASDF compiled with warnings" 1)) (errors-p (leave-lisp "Testsuite failed: ASDF compiled with ERRORS" 2)) (t - #+ecl - (when warnings-p - (format t "~&ASDF compiled with warnings. Please fix ECL.~%")) (when (probe-file *asdf-fasl*) (delete-file *asdf-fasl*)) (rename-file tmp *asdf-fasl*) diff --git a/test/run-tests.sh b/test/run-tests.sh index da2ba6821e18db1695cc061a7574e33c7459b958..abd8752108c49c0fdc55e0b82f9187befddfdaa2 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -86,6 +86,7 @@ do_tests() { echo " $test_pass passing and $test_fail failing" >&2 if [ $test_fail -eq 0 ] ; then echo "all tests apparently successful" >&2 + echo success > ../tmp/results/status else echo "failing test(s): $failed_list" >&2 fi @@ -190,8 +191,11 @@ if [ -z "$command" ] ; then else create_config mkdir -p ../tmp/results + echo failure > ../tmp/results/status thedate=`date "+%Y-%m-%d"` do_tests "$command" "$eval" 2>&1 | \ tee "../tmp/results/${lisp}.text" "../tmp/results/${lisp}-${thedate}.save" + read a < ../tmp/results/status clean_up + [ success = "$a" ] ## exit code fi