test1.script 2.45 KB
Newer Older
Daniel Barlow's avatar
Daniel Barlow committed
1
;;; -*- Lisp -*-
2

3
(load-asdf)
4

5 6 7 8 9 10 11
(touch-file (test-source "test1.asd") :offset -3600) ;; touch test1.asd an hour ago.
(defparameter *date* (file-write-date (test-source "test1.asd")))

(touch-file (test-source "file1.lisp") :timestamp (+ *date* 100))
(touch-file (test-source "file2.lisp") :timestamp (+ *date* 200))
(assert-equal (file-write-date (test-source "file1.lisp")) (+ *date* 100))
(assert-equal (file-write-date (test-source "file2.lisp")) (+ *date* 200))
12

13
(DBG "loading test1")
14
(load-system 'test1)
15

16 17 18 19
(defparameter *file1.out* (output-files 'compile-op '(test1 "file1")))
(defparameter *file2.out* (output-files 'compile-op '(test1 "file2")))
(assert-equal (first *file1.out*) (test-fasl "file1"))
(assert-equal (first *file2.out*) (test-fasl "file2"))
20

21 22 23
(assert-equal *date* (file-write-date (test-source "test1.asd")))
(defparameter *then* (file-write-date (first *file2.out*)))
(assert-compare (< *date* *then*))
24 25

(DBG "test that it compiled" *date* *then*)
26 27
(dolist (f (append *file1.out* *file2.out*))
  (eval `(assert (probe-file ,f))))
28 29 30 31

(DBG "and loaded")
(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))

32 33 34 35 36
(DBG "now remove file2 that depends-on file1")
(dolist (f *file1.out*) (touch-file f :timestamp (+ *date* 500)))
(assert-equal (+ *date* 500) (file-write-date (first *file1.out*)))
(map () 'delete-file-if-exists *file2.out*)
(clear-system 'test1)
37 38

(DBG "load again")
39 40 41 42 43 44 45 46
;;(trace input-files asdf::compute-action-stamp)
(defparameter *plan* (nth-value 1 (operate 'load-op 'test1)))
(DBG "check that file1 is _not_ recompiled, but file2 is")
(assert (in-plan-p *plan* '(compile-op "test1" "file2")))
(assert (not (in-plan-p *plan* '(compile-op "test1" "file1"))))

(assert-equal (+ *date* 500) (file-write-date (first *file1.out*)))
(assert-compare (<= *then* (file-write-date (first *file2.out*))))
47 48 49 50

(DBG "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
51 52 53
(defparameter *before* (file-write-date (first *file2.out*)))
(touch-file (test-source "file1.lisp") :timestamp (+ *date* 3000)) ;; touch file1 a minute ago.
(dolist (f *file2.out*) (touch-file f :timestamp (+ *date* 2000))) ;; touch file2.fasl some time before.
54 55
(asdf:clear-system 'test1)
(asdf:operate 'asdf:load-op 'test1)
56 57 58
(DBG :foo (file-write-date (first *file2.out*)) *before*)
(assert-compare (>= (file-write-date (first *file2.out*)) *before*))