1;;; -*- Lisp -*-
2
3(setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*))
4
5;; We need use the pathnames used by ASDF.
6(defparameter test1.asd (system-source-file 'test1))
7(defparameter file1.lisp (component-pathname (find-component 'test1 "file1")))
8(defparameter file2.lisp (component-pathname (find-component 'test1 "file2")))
9(assert-pathname-equal test1.asd (test-source "test1.asd")) ; unhappily, not usually equal.
10(assert-pathname-equal file1.lisp (test-source "file1.lisp")) ; unhappily, not usually equal.
11(assert-pathname-equal file2.lisp (test-source "file2.lisp")) ; unhappily, not usually equal.
12(defparameter *file1.out* (output-files 'compile-op '(test1 "file1")))
13(defparameter *file2.out* (output-files 'compile-op '(test1 "file2")))
14(defparameter file1.fasl (first *file1.out*))
15(defparameter file2.fasl (first *file2.out*))
16(assert-pathname-equal file1.fasl (test-fasl "file1"))
17(assert-pathname-equal file2.fasl (test-fasl "file2"))
18
19(defparameter *date* (- (file-write-date test1.asd) 3600))
20(touch-file test1.asd :timestamp *date*) ;; touch test1.asd an hour back.
21(touch-file file1.lisp :timestamp *date* :offset 100)
22(touch-file file2.lisp :timestamp *date* :offset 200)
23(assert-equal (get-file-stamp file1.lisp) (+ *date* 100))
24(assert-equal (get-file-stamp file2.lisp) (+ *date* 200))
25(DBG "loading test1")
26(load-system 'test1)
27
28(defparameter *then* (file-write-date (first *file2.out*)))
29(assert-compare (<= (+ *date* 3600) *then*))
30
31(DBG "test that it compiled" *date* *then*)
32(dolist (f (append *file1.out* *file2.out*))
33  (eval `(assert (probe-file ,f))))
34
35(DBG "and loaded")
36(assert (asymval :*file1* :test-package))
37
38(DBG "now remove file2 that depends-on file1")
39(dolist (f *file1.out*) (touch-file f :timestamp (+ *date* 500)))
40(assert-equal (+ *date* 500) (get-file-stamp file1.fasl))
41(map () 'mark-file-deleted *file2.out*)
42(clear-system 'test1)
43
44(DBG "load again")
45(defparameter *plan* (nth-value 1 (operate 'load-op 'test1)))
46(DBG "check that file1 is _not_ recompiled, but file2 is")
47(assert (in-plan-p *plan* '(compile-op "test1" "file2")))
48(assert (not (in-plan-p *plan* '(compile-op "test1" "file1"))))
49
50(assert-equal (+ *date* 500) (get-file-stamp file1.fasl))
51(defparameter *before* (get-file-stamp file2.fasl))
52(assert-compare (<= *then* *before*))
53
54(DBG "now touch file1 and check that file2 _is_ also recompiled")
55;; XXX run-shell-command loses if *default-pathname-defaults* is not the
56;; unix cwd.  this is not a problem for run-tests.sh, but can be in general
57(touch-file file1.lisp :timestamp (+ *date* 3000)) ;; touch file1 a minute ago.
58(dolist (f *file2.out*) (touch-file f :timestamp (+ *date* 2000))) ;; touch file2.fasl some time before.
59(asdf:clear-system 'test1)
60(asdf:operate 'asdf:load-op 'test1)
61(DBG :foo (file-write-date file2.fasl) *before*)
62(assert-compare (>= (file-write-date file2.fasl) *before*))
63
64