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