test-touch-system-1.script 1.25 KB
Newer Older
1 2 3 4
;;; -*- Lisp -*-

;;; test system def reloading if touched
;;; system that can be found using *system-definition-search-functions*
5
(defun system-registered-time (name)
6
  (car (asdf::system-registered-p name)))
7

8 9 10 11 12 13 14
(defparameter test1.asd (nth-value 2 (locate-system :test1)))
(assert-pathname-equal test1.asd (test-source "test1.asd"))
(defparameter file1.lisp (test-source "file1.lisp"))
(defparameter file2.lisp (test-source "file2.lisp"))
(defparameter file1.fasl (test-fasl "file1.lisp"))
(defparameter file2.fasl (test-fasl "file2.lisp"))
(defparameter date1 (get-file-stamp test1.asd))
15 16
(defparameter date2 (- date1 600))
(defparameter date3 (- date1 300))
17

18
(clear-system :test1)
19 20 21 22
(touch-file test1.asd :timestamp date2)
(touch-file file1.lisp :timestamp date3)
(touch-file file2.lisp :timestamp date3)
(assert-equal nil (system-registered-time :test1))
23
(load-system :test1)
24 25 26 27
(defparameter date4 (get-file-stamp file2.fasl))
(defparameter date5 (system-registered-time :test1))
(DBG :blah date1 date2 date3 date4 date5)
(assert-equal date2 date5)
28
(assert-equal date2 date5)
29
(assert-compare (>= date4 date3))
30
(sleep 1)
31

32
(clear-system :test1)
33
(touch-file test1.asd :offset 600)
34
(find-system :test1)
35
(defparameter date6 (system-registered-time :test1))
36
(assert-compare (> date6 date4))