test-touch-system-1.script 1.44 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 6 7

(setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*))

8
(defun system-registered-time (name)
9 10 11
  (asdf::component-operation-time
   'asdf::define-op
   (registered-system (primary-system-name name))))
12
(setf (asdf-upgraded-p *asdf-session*) t)
13

14 15 16 17 18 19 20
(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))
21 22
(defparameter date2 (- date1 600))
(defparameter date3 (- date1 300))
23

24
(clear-system :test1)
25 26 27 28
(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))
29
(load-system :test1)
30 31 32 33
(defparameter date4 (get-file-stamp file2.fasl))
(defparameter date5 (system-registered-time :test1))
(DBG :blah date1 date2 date3 date4 date5)
(assert-equal date2 date5)
34
(assert-equal date2 date5)
35
(assert-compare (>= date4 date3))
36
(sleep 1)
37

38
(clear-system :test1)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
39
(touch-file test1.asd :timestamp date4 :offset 600)
40
(find-system :test1)
41
(defparameter date6 (system-registered-time :test1))
42
(assert-compare (> date6 date4))