test-force.script 4.31 KB
Newer Older
1
;;; -*- Lisp -*-
2

3
4
5
6
7
8
9
(clear-system 'test-asdf/force)
(assert (not (component-loaded-p 'test-asdf/force)))

(require-system 'test-asdf/force)
(assert (component-loaded-p 'test-asdf/force))
(assert-equal (asymval :*file3* :test-package) t)
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
10

11
12
13
14
(defparameter file1 (test-fasl "file1"))
(defparameter file1-date (file-write-date file1))
(defparameter date1 (- file1-date 600))
(defparameter date2 (- file1-date 300))
15

16
17
(assert file1)
(assert file1-date)
18

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
(let ((plan (traverse 'load-op 'test-asdf/force :force t)))
  (DBG "Check that :force t forces the current system but not its dependencies" plan)
  (assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file3")))
  (assert (not (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1")))))

(let ((plan (traverse 'load-op 'test-asdf/force :force :all)))
  (DBG "Check that :force :all forces the current system and its dependencies" plan)
  (assert plan)
  (assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file3")))
  (assert (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1"))))

(let ((plan (traverse 'load-op 'test-asdf/force :force :all :force-not t)))
  (DBG "Check that :force-not takes precedence over :force, with t means \"all but current system\"" plan)
  (assert plan)
  (assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file3")))
  (assert (not (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1")))))

(let ((plan (traverse 'load-op 'test-asdf/force :force-not :all)))
  (DBG "Check that :force-not :all means \"all systems\"" plan)
  (assert (null plan)))

(let ((plan (traverse 'load-op 'test-asdf/force :force :all :force-not :all)))
  (DBG "Check that :force-not :all takes precedence over :force" plan)
  (assert (null plan)))

44
45
46
47
48
(let ((plan (traverse 'load-op 'test-asdf/force :force :all
		      :force-not '(:test-asdf/force :test-asdf/force1))))
  (DBG "Check that :force-not :all takes precedence over :force" plan)
  (assert (null plan)))

49
50
51
52
53
54
(let* ((*immutable-systems* (list-to-hash-set '("test-asdf/force1")))
       (plan (traverse 'load-op 'test-asdf/force :force :all :force-not t)))
  (DBG "Check that immutable-systems will block forcing" plan)
  (assert plan)
  (assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file3")))
  (assert (not (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1")))))
55

56
;; unforced, date should stay same
57
(touch-file "test-asdf.asd" :timestamp date1)
58
59
(touch-file "file1.lisp" :timestamp date1)
(touch-file file1 :timestamp date2)
60
61
62
63
(setf test-package::*file1* :modified)
(DBG "Check the fake dates from touch-file")
(assert-equal (get-file-stamp "test-asdf.asd") date1)
(assert-equal (get-file-stamp "file1.lisp") date1)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
64
(assert-equal (get-file-stamp file1) date2)
65

66
67
68
69
70
71
72
(DBG "Check that require-system won't reload")
(require-system 'test-asdf/force1)
(assert-equal (get-file-stamp file1) date2)
(assert-equal test-package::*file1* :modified)

(DBG "Check that load-system will reload")
(load-system 'test-asdf/force1)
73
(with-expected-failure (#+(or clasp clisp (and ecl (not ecl-bytecmp)) mkcl) t)
74
75
76
  ;; Why does that fail on these??? Investigate!
  (assert-equal (get-file-stamp file1) date2)
  (assert-equal test-package::*file1* t))
77

78
;; forced, it should be later
79
80
(DBG "Check that force reloading loads again")
(setf test-package::*file3* :reset)
81
(load-system 'test-asdf/force :force :all)
82
(assert-compare (>= (get-file-stamp file1) file1-date))
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
(assert-equal test-package::*file3* t)

(DBG "Check that test-asdf was loaded only once all along")
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)

(setf test-package::*file3* :reset)

(DBG "Check that require-system of touched .asd will reload the asdf.")
(DBG "(That's what it does now, but if it could be fixed that'd be nice.)")
(unset-asdf-cache-entry '(find-system "test-asdf"))
(unset-asdf-cache-entry '(find-system "test-asdf/force"))
(touch-file "test-asdf.asd" :timestamp (+ 10000 (get-file-stamp file1)))
(require-system 'test-asdf/force)
(assert-equal (asymval :*times-loaded* :test-asdf-system) 2)
(assert-equal test-package::*file3* :reset)

(DBG "Check that require-system of untouched .asd won't reload the asdf.")
(require-system 'test-asdf/force)

;;; Somehow, it loads the system...
(with-expected-failure (t)
  (assert-equal (asymval :*times-loaded* :test-asdf-system) 2)
  (assert-equal test-package::*file3* :reset))