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

Fix test infrastructure, fix test scripts. Pass again on CCL.

parent 2f60807e
......@@ -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
......
......@@ -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)))
;;; -*- 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))))
......@@ -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))))
......@@ -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)))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment