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
Loading
Loading
Loading
Loading
+2 −2
Original line number Diff line number Diff line
@@ -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
+8 −8
Original line number Diff line number Diff line
@@ -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)
  (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)))
+15 −10
Original line number Diff line number Diff line
;;; -*- 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")))

  (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 (= (file-write-date (asdf:compile-file-pathname* "file1")) file1-date))
    (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)))
    (assert (> (file-write-date file1) file1-date))))
+7 −8
Original line number Diff line number Diff line
@@ -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")))

 ;; cheat
 (setf asdf::*defined-systems* (make-hash-table :test 'equal))
 (let* ((file1 (asdf:compile-file-pathname* (truename "file1.lisp")))
        (file1-date (file-write-date file1))
        (asdf::*defined-systems* (make-hash-table :test 'equal))) ;; cheat

   ;; 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)))
   (assert (= (file-write-date file1) file1-date))))
+23 −20
Original line number Diff line number Diff line
@@ -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)))
   (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

 (asdf::run-shell-command "rm -f ~A"
                          (namestring (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 (asdf:compile-file-pathname* "file1"))))
 (assert (file-write-date (asdf:compile-file-pathname* "file2")))
   (assert (= file1-date (file-write-date file1)))
   (assert (file-write-date file2))

   ;; 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

 (let ((before (file-write-date (asdf:compile-file-pathname* "file2"))))
   (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 (asdf:compile-file-pathname* "file2")) before))))
     (assert (>  (file-write-date file2) before)))))