diff --git a/test/run-tests.sh b/test/run-tests.sh index 5f04d6fc3fce36a49bf15e53128809f145f4ed6c..730de0cac9f5976a4ce65513d16267fb6fe7ea4e 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -6,13 +6,13 @@ # - quit with exit status >0 if an unhandled error occurs export CL_SOURCE_REGISTRY="$PWD" -export DEBUG_ASDF_TEST= +unset DEBUG_ASDF_TEST while getopts "duh" OPTION do case $OPTION in d) - DEBUG_ASDF_TEST=1 + export DEBUG_ASDF_TEST=t ;; u) usage diff --git a/test/script-support.lisp b/test/script-support.lisp index bdcea5827758ebca052a94ef0b97754a327ce3bd..deb4013ab48878a0602b116d3c146034b1e46b42 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -34,11 +34,11 @@ "Unless the environment variable DEBUG_ASDF_TEST is bound, write a message and exit on an error. If *asdf-test-debug* is true, enter the debugger." - (handler-case - (progn (funcall thunk) - (leave-lisp "~&Script succeeded~%" 0)) - (error (c) - (format *error-output* "~a" c) - (if (ignore-errors (funcall (find-symbol "GETENV" :asdf) "DEBUG_ASDF_TEST")) - (break) - (leave-lisp "~&Script failed~%" 1))))) + (handler-bind + ((error (lambda (c) + (format *error-output* "~a" c) + (if (ignore-errors (funcall (find-symbol "GETENV" :asdf) "DEBUG_ASDF_TEST")) + (break) + (leave-lisp "~&Script failed~%" 1))))) + (funcall thunk) + (leave-lisp "~&Script succeeded~%" 0))) diff --git a/test/test-force.script b/test/test-force.script index 9a4fcbfd4b39e8b16437557faa01715678f7e2f4..47e8569b367c4315d36fc663e25545b38064f95c 100644 --- a/test/test-force.script +++ b/test/test-force.script @@ -1,18 +1,23 @@ ;;; -*- Lisp -*- (load "script-support") (load (compile-file-pathname "../asdf")) + (quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (asdf:operate 'asdf:load-op 'test-force) - (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1"))) - ;; unforced, date should stay same - (sleep 1) - (asdf:operate 'asdf:load-op 'test-force) - (assert (= (file-write-date (asdf:compile-file-pathname* "file1")) file1-date)) + (let* ((file1 (asdf:compile-file-pathname* (truename "file1.lisp"))) + (file1-date (file-write-date file1))) + + (assert file1) + (assert file1-date) + + ;; unforced, date should stay same + (sleep 1) + (asdf:operate 'asdf:load-op 'test-force) + (assert (equal (file-write-date file1) file1-date)) - ;; forced, it should be later - (sleep 1) - (asdf:operate 'asdf:load-op 'test-force :force t) - (assert (> (file-write-date (asdf:compile-file-pathname* "file1")) file1-date))) + ;; forced, it should be later + (sleep 1) + (asdf:operate 'asdf:load-op 'test-force :force t) + (assert (> (file-write-date file1) file1-date)))) diff --git a/test/test-static-and-serial.script b/test/test-static-and-serial.script index e85b5a02f2c07d2cfc2c2a506ff645de2cb4dada..a5138196317eb2a5d206aceda9fc447722e536a0 100644 --- a/test/test-static-and-serial.script +++ b/test/test-static-and-serial.script @@ -5,12 +5,11 @@ (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:operate 'asdf:load-op 'static-and-serial) - (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1"))) + (let* ((file1 (asdf:compile-file-pathname* (truename "file1.lisp"))) + (file1-date (file-write-date file1)) + (asdf::*defined-systems* (make-hash-table :test 'equal))) ;; cheat - ;; cheat - (setf asdf::*defined-systems* (make-hash-table :test 'equal)) - - ;; date should stay same - (sleep 1) - (asdf:operate 'asdf:load-op 'static-and-serial) - (assert (= (file-write-date (asdf:compile-file-pathname* "file1")) file1-date))) + ;; date should stay same + (sleep 1) + (asdf:operate 'asdf:load-op 'static-and-serial) + (assert (= (file-write-date file1) file1-date)))) diff --git a/test/test1.script b/test/test1.script index 6183b17ffa3c391f6c23d5b6aff4af8afef33a11..b759ea5cbf2067c636b0a6e91d3f5e5c74d34e27 100644 --- a/test/test1.script +++ b/test/test1.script @@ -7,30 +7,33 @@ (asdf:operate 'asdf:load-op 'test1) ;; test that it compiled - (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1"))) + (let* ((file1 (asdf:compile-file-pathname* (truename "file1.lisp"))) + (file2 (asdf:compile-file-pathname* (truename "file2.lisp"))) + (file1-date (file-write-date file1))) - (assert (and file1-date (file-write-date (asdf:compile-file-pathname* "file2")))) + (format t "~&test1 1: ~S ~S~%" file1 file1-date) + (assert file1-date) + (assert (file-write-date file2)) - ;; and loaded - (assert (eval (intern (symbol-name '#:*file1*) :test-package))) + ;; and loaded + (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package))) - ;; now remove one output file and check that the other is _not_ - ;; recompiled - (sleep 1) ; mtime has 1-second granularity, so pause here for fast machines + ;; now remove one output file and check that the other is _not_ + ;; recompiled + (sleep 1) ; mtime has 1-second granularity, so pause here for fast machines - (asdf::run-shell-command "rm -f ~A" - (namestring (asdf:compile-file-pathname* "file2"))) - (asdf:operate 'asdf:load-op 'test1) - (assert (= file1-date (file-write-date (asdf:compile-file-pathname* "file1")))) - (assert (file-write-date (asdf:compile-file-pathname* "file2"))) + (asdf::run-shell-command "rm -f ~A" (namestring file2)) + (asdf:operate 'asdf:load-op 'test1) + (assert (= file1-date (file-write-date file1))) + (assert (file-write-date file2)) - ;; now touch file1 and check that file2 _is_ also recompiled + ;; now touch file1 and check that file2 _is_ also recompiled - ;; XXX run-shell-command loses if *default-pathname-defaults* is not the - ;; unix cwd. this is not a problem for run-tests.sh, but can be in general + ;; XXX run-shell-command loses if *default-pathname-defaults* is not the + ;; unix cwd. this is not a problem for run-tests.sh, but can be in general - (let ((before (file-write-date (asdf:compile-file-pathname* "file2")))) - (asdf::run-shell-command "touch file1.lisp") - (sleep 1) - (asdf:operate 'asdf:load-op 'test1) - (assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before)))) + (let ((before (file-write-date file2))) + (asdf::run-shell-command "touch file1.lisp") + (sleep 1) + (asdf:operate 'asdf:load-op 'test1) + (assert (> (file-write-date file2) before)))))