diff --git a/doc/index.html b/doc/index.html index 29a83c701bee6cb6a9967315afabac2cc8303a74..7c5bdda3f95a7d869c793232af3a162b70395ee8 100644 --- a/doc/index.html +++ b/doc/index.html @@ -167,7 +167,7 @@ though there might never be a next release to provide it through <tt>require</tt>. </p> - <table> + <table border="1"> <tr><th></th> <th align="left">Provide ASDF 3</th> <th align="left">Provide ASDF 2</th> diff --git a/test/script-support.lisp b/test/script-support.lisp index 0a70c05f042d4c325833c6e10f7d63133527590d..a09eae12bcfd2899ae6dc28f9ed3088bac1a9aea 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -15,6 +15,7 @@ Some constraints: (:export #:asym #:acall #:asymval #:*test-directory* #:*asdf-directory* #:*build-directory* #:*implementation* + #:deftest #:is #:signals #:assert-compare #:assert-equal #:assert-pathname-equal #:assert-pathnames-equal #:hash-table->alist #:load-asdf #:maybe-compile-asdf @@ -105,8 +106,27 @@ Some constraints: (redirect-outputs) ;; Put everything on standard output, for the sake of scripts -;;; Helpful for debugging +;;; Poor man's test suite, lacking stefil. +(defmacro deftest (name formals &body body) + `(defun ,name ,formals ,@body)) +(defmacro is (x) + `(progn + (format *error-output* "~&Checking whether ~S~%" ',x) + (finish-output *error-output*) + (assert ,x))) +(defmacro signals (condition sexp) + `(progn + (format *error-output* "~&Checking whether ~S signals ~S~%" ',sexp ',condition) + (finish-output *error-output*) + (handler-case + ,sexp + (,condition () t) + (t (c) + (error "Expression ~S raises signal ~S, not ~S" ',sexp c ',condition)) + (:no-error () + (error "Expression ~S fails to raise condition ~S" ',sexp ',condition))))) +;;; Helpful for debugging (defun pathname-components (p) (when p (let ((p (pathname p))) diff --git a/test/stamp-propagation/file1.lisp b/test/stamp-propagation/file1.lisp new file mode 100644 index 0000000000000000000000000000000000000000..2ff2dbfee5ad50040cfa201bb38901d9ee3c0c11 --- /dev/null +++ b/test/stamp-propagation/file1.lisp @@ -0,0 +1,2 @@ +(in-package :asdf-test) +(eval-note :file1) diff --git a/test/stamp-propagation/file2.lisp b/test/stamp-propagation/file2.lisp new file mode 100644 index 0000000000000000000000000000000000000000..05679fd17d12090172dba7f0612b29b09405271c --- /dev/null +++ b/test/stamp-propagation/file2.lisp @@ -0,0 +1,2 @@ +(in-package :asdf-test) +(eval-note :file2) diff --git a/test/stamp-propagation/test-stamp-propagation.lisp b/test/stamp-propagation/test-stamp-propagation.lisp new file mode 100644 index 0000000000000000000000000000000000000000..5f071361319ab6b811abe535b27f9298b600853b --- /dev/null +++ b/test/stamp-propagation/test-stamp-propagation.lisp @@ -0,0 +1,153 @@ +;; NB: this file is supposed to work using old defsystems +;; including not just ASDF2, but also legacy defsystems from allegro, genera, lispworks + +(unless (find-package :asdf-test) + (load (merge-pathnames + (make-pathname :defaults *load-pathname* + :name "script-support" :directory '(:relative :back)) + *load-pathname*))) + +(unless (find-package :asdf) + (asdf-test::load-asdf) + (asdf-test::frob-packages)) + +(in-package :asdf-test) + +(DBG :foo) + +(defparameter *eval-notes* ()) +(defun note-eval (when file) + (format t "~&XXX ~S ~S~%" when file) + (push `(,when ,file #|,*load-pathname* ,*compile-file-pathname*|#) *eval-notes*)) +(defun eval-notes () + (prog1 (reverse *eval-notes*) (setf *eval-notes* nil))) +(defmacro eval-note (&optional x) + `(progn + (eval-when (:compile-toplevel) (note-eval :compile-toplevel ',x)) + (eval-when (:load-toplevel) (note-eval :load-toplevel ',x)) + (eval-when (:execute) (note-eval :execute ',x)))) + + +(eval-note :tsp) + +(defvar *tsp* (asdf::pathname-directory-pathname *load-pathname*)) + +(defparameter asdf::*asdf-cache* nil) ;; disable any surrounding cache on ASDF3. + +#+allegro +(excl:defsystem :test-stamp-propagation + (:default-pathname #.*tsp*) + (:definitions + "file1.lisp" + "file2.lisp")) + +#+genera +(sct:defsystem :test-stamp-propagation + (:default-pathname #.*tsp* :patchable nil) + (:definitions + "file1.lisp" + "file2.lisp")) + +#+lispworks +(scm:defsystem :test-stamp-propagation + (:default-pathname #.*tsp*) + :members ("file1" "file2") + :rules ((:in-order-to :compile ("file2") + (:caused-by (:compile "file1")) + (:requires (:load "file1"))))) + +#+asdf +(asdf:defsystem :test-stamp-propagation + :pathname #.*tsp* :source-file nil + :serial t + :components + ((:file "file1") + (:file "file2"))) + +#+mk-defsystem +(mk:defsystem :test-stamp-propagation + (:default-pathname #.*tsp* :patchable nil) + (:serial + "file1.lisp" + "file2.lisp")) + +(defvar *default-defsystem* (or #+(or allegro genera lispworks) :native + #+asdf :asdf + #+mk-defsystem :mk-defsystem)) + +(defun reload (&optional (defsystem *default-defsystem*)) + (format t "~&ASDF-CACHE ~S~%" asdf::*asdf-cache*) + (setf *eval-notes* nil) + (setf *compile-verbose* t *load-verbose* t) + (ecase defsystem + #+asdf + (:asdf + (note-eval :compiling :system) + (asdf:compile-system :test-stamp-propagation) + (note-eval :loading :system) + (asdf:load-system :test-stamp-propagation)) + #+mk-defsystem + (:mk-defsystem + (note-eval :compiling :system) + (mk:compile-system :test-stamp-propagation) + (note-eval :loading :system) + (mk:load-system :test-stamp-propagation)) + (:native + (note-eval :compiling :system) + #+allegro (excl:compile-system :test-stamp-propagation) + #+lispworks (scm:compile-system :test-stamp-propagation) + #+genera (sct:compile-system :test-stamp-propagation) + (note-eval :loading :system) + #+allegro (excl:load-system :test-stamp-propagation) + #+lispworks (scm:load-system :test-stamp-propagation) + #+genera (sct:load-system :test-stamp-propagation))) + (let ((n (eval-notes))) + (format t "~&EVAL-NOTES ~S~%" n) + n)) + +#-genera +(defun touch-file1.lisp () + (touch-file (asdf::subpathname *tsp* "file1.lisp") + :in-filesystem t)) + +#-genera +(defun touch-file1.fasl (&optional (defsystem *default-defsystem*)) + (touch-file (funcall + (case defsystem (:asdf 'asdf::compile-file-pathname*) (t 'compile-file-pathname)) + (asdf::subpathname *tsp* "file1.lisp")) + :in-filesystem t)) + +(defun sanitize-log (log) + (remove-duplicates + (remove '(:loading :system) log :test 'equal) + :test 'equal :from-end t)) + +(defun test-defsystem (&optional (defsystem *default-defsystem*)) + (format t "~&Testing stamp propagation by defsystem ~S~%" defsystem) + (DBG "loading system") + (reload defsystem) + (sleep 1) + (DBG "touching first source file and reloading") + (DBG "defsystem should recompile & reload everything") + (touch-file1.lisp) + (assert-equal (sanitize-log (reload defsystem)) + '((:compiling :system) (:compile-toplevel :file1) (:load-toplevel :file1) + (:compile-toplevel :file2) (:load-toplevel :file2))) + (sleep 1) + (DBG "touching first fasl file and reloading") + (DBG "defsystem should reload it, recompile & reload the other") + (touch-file1.fasl defsystem) + (assert-equal (sanitize-log (reload defsystem)) + '((:compiling :system) (:load-toplevel :file1) + (:compile-toplevel :file2) (:load-toplevel :file2)))) + +(test-defsystem :asdf) + +#+(or genera) +(test-defsystem :native) + +#+(or allegro lispworks) +(signals error (test-defsystem :native)) + +#+mkdefsystem +(signals error (test-defsystem :mk-defsystem)) diff --git a/test/test-run-program.script b/test/test-run-program.script index 34f375b1bf0b62016eb2bd5d2b95fb1e2f6cb85e..ea7374ab9f25d9746d00ef947b09838ab39a54a8 100644 --- a/test/test-run-program.script +++ b/test/test-run-program.script @@ -81,24 +81,6 @@ ;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess) ;;#+lispworks (trace system:run-shell-command system:pid-exit-status) -;; Poor man's test suite, lacking stefil. -(defmacro deftest (name formals &body body) - `(defun ,name ,formals ,@body)) -(defmacro is (x) - `(progn - (format! *error-output* "~&Checking whether ~S~%" ',x) - (assert ,x))) -(defmacro signals (condition sexp) - `(progn - (format! *error-output* "~&Checking whether ~S signals ~S~%" ',sexp ',condition) - (handler-case - ,sexp - (,condition () t) - (t (c) - (error "Expression ~S raises signal ~S, not ~S" ',sexp c ',condition)) - (:no-error () - (error "Expression ~S fails to raise condition ~S" ',sexp ',condition))))) - #| Testing run-program |# diff --git a/test/test-stamp-propagation.script b/test/test-stamp-propagation.script new file mode 100644 index 0000000000000000000000000000000000000000..084bc8ae9359c50b7153a4dc837a3b43b6167722 --- /dev/null +++ b/test/test-stamp-propagation.script @@ -0,0 +1 @@ +(load (subpathname *test-directory* "stamp-propagation/test-stamp-propagation.lisp")) diff --git a/upgrade.lisp b/upgrade.lisp index f2edc4042a3e25a2d163526f740c85704cfdadf7..fd16fc801e5ddae1ad1009e07a208ebbc65840ed 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -57,8 +57,8 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) (push existing-version *previous-asdf-versions*) - (when (or *load-verbose* *verbose-out*) - (format *trace-output* + (when (or *verbose-out* *load-verbose*) + (format (or *verbose-out* *trace-output*) (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%") existing-version asdf-version)))))