-
Notifications
You must be signed in to change notification settings - Fork 35
/
Copy pathtest-force.script
170 lines (144 loc) · 6.99 KB
/
test-force.script
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
;;; -*- Lisp -*-
(setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*))
(chdir *test-directory*)
;;(setf *defaut-pathname-defaults* *test-directory*)
(clear-system 'test-asdf/force)
(assert (not (component-loaded-p 'test-asdf/force)))
(defun force-plan (&rest forcing-options)
(asdf::make-plan nil 'load-op 'test-asdf/force
:forcing (apply 'asdf::make-forcing :system 'test-asdf/force forcing-options)))
(defvar *plan* nil)
(defun component-out-of-date-p (component)
(not
(asdf::action-up-to-date-p
*plan*
(make-operation 'load-op)
(find-component component nil :registered t))))
(defun plan-loads-p (component)
(member (asdf::make-action (make-operation 'load-op) (find-component () component :registered t))
(asdf::plan-actions *plan*) :test 'equal))
(with-asdf-session (:override t :override-forcing t)
(load-system 'test-asdf/force))
(assert (component-loaded-p 'test-asdf/force))
(assert-equal (asymval :*file3* :test-package) t)
(assert-equal (asymval :*file4* :test-package) t)
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
(assert-equal (asymval :*file3-only-asd-loaded* :asdf-user) 1)
(defparameter file1 (test-fasl "file1"))
(defparameter file1-date (file-write-date file1))
(defparameter date1 (- file1-date 600))
(defparameter date2 (- file1-date 300))
(assert file1)
(assert file1-date)
(reset-session-visited)
(defparameter *plan* (force-plan :force t))
(DBG "Check that :force t forces the current system but not its dependencies" *plan*)
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
(assert (not (component-out-of-date-p '("file3-only" "file3"))))
(assert (not (component-out-of-date-p '("test-asdf/force1" "file1"))))
(reset-session-visited)
(defparameter *plan* (force-plan :force :all))
(DBG "Check that :force :all forces the current system and its dependencies" *plan*)
(assert (asdf::plan-actions *plan*))
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
(assert (component-out-of-date-p '("file3-only" "file3")))
(assert (component-out-of-date-p '("test-asdf/force1" "file1")))
(reset-session-visited)
(defparameter *plan* (force-plan :force :all :force-not t))
(DBG "Check that :force-not takes precedence over :force, with t means \"all but current system\"" *plan*)
(assert (asdf::plan-actions *plan*))
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
(assert (not (component-out-of-date-p '("file3-only" "file3"))))
(assert (not (component-out-of-date-p '("test-asdf/force1" "file1"))))
(reset-session-visited)
(defparameter *plan* (force-plan :force-not :all))
(DBG "Check that :force-not :all means \"all systems\"" *plan*)
(assert (null (asdf::plan-actions *plan*)))
(reset-session-visited)
(defparameter *plan* (force-plan :force :all :force-not :all))
(DBG "Check that :force-not :all takes precedence over :force" *plan*)
(assert (null (asdf::plan-actions *plan*)))
(reset-session-visited)
(defparameter *plan* (force-plan :force :all :force-not '(:test-asdf/force)))
(DBG "Check that :force-not with a list takes precedence over :force" *plan*)
(assert (null (asdf::plan-actions *plan*)))
(reset-session-visited)
(defparameter *plan* (force-plan :force :all :force-not '(:test-asdf/force1)))
(DBG "Check that :force-not with a list takes precedence over :force, 2" *plan*)
(assert (asdf::plan-actions *plan*))
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
;; transitively included via test-asdf/force1 test-asdf/only, which blocks the traversal
(assert (not (plan-loads-p '("file3-only" "file3"))))
(assert (component-out-of-date-p '("file3-only" "file3")))
(assert (not (component-out-of-date-p '("test-asdf/force1" "file1"))))
(reset-session-visited)
(let* ((asdf::*immutable-systems* (list-to-hash-set '("test-asdf/force1")))
(*plan* (force-plan :force :all)))
(DBG "Check that immutable-systems will block forcing" *plan*)
(assert (asdf::plan-actions *plan*))
(assert (component-out-of-date-p '("test-asdf/force" "file4")))
;; transitively included via force1 test-asdf/only, which blocks the traversal
(assert (not (plan-loads-p '("file3-only" "file3"))))
(assert (component-out-of-date-p '("file3-only" "file3")))
(assert (not (component-out-of-date-p '("test-asdf/force1" "file1")))))
;; unforced, date should stay same
(touch-file "test-asdf.asd" :timestamp date1)
(touch-file "file1.lisp" :timestamp date1)
(touch-file file1 :timestamp date2)
(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)
(assert-equal (get-file-stamp file1) date2)
(DBG "Check that require-system won't reload")
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
(require-system 'test-asdf/force1))
(assert-equal (get-file-stamp file1) date2)
(assert-equal test-package::*file1* :modified)
;;; So far, only loaded things once
(assert-equal test-asdf-system::*times-loaded* 1)
(DBG "Check that load-system will reload")
(reset-session-visited)
(setf test-package::*file1* nil)
(setf test-asdf-system::*times-loaded* 10)
(assert (not test-package::*file1*))
(with-asdf-session (:override t :override-forcing t)
(load-system 'test-asdf/force1))
(assert test-package::*file1*)
;;; This caused a second loading
;; NB: Somehow this is only 1 when using asdf-tools??? WTF?
;; running from asdf with test/ in paths vs running from test/ with no path prefix.
;;(assert-equal (asymval :*times-loaded* :test-asdf-system) 11)
;;TODO: understand what's going on above!
;; forced, it should be later
(DBG "Check that force reloading loads again")
(setf test-asdf-system::*times-loaded* 20)
(reset-session-visited)
(setf test-package::*file3* :reset)
(with-asdf-session (:override t :override-forcing t)
(load-system 'test-asdf/force :force :all))
(assert-compare (>= (- (get-file-stamp file1) file1-date) 0))
(assert-equal test-package::*file3* t)
(DBG "Check that test-asdf.asd was loaded each time it was forced")
(assert-equal test-asdf-system::*times-loaded* 21)
(DBG "Check that file3-only.asd was loaded only twice, with the :force :all")
(assert-equal asdf-user::*file3-only-asd-loaded* 2)
(DBG "Check that require-system called with touched .asd won't reload the asdf.")
(setf test-asdf-system::*times-loaded* 30)
(setf test-package::*file3* :reset)
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
(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 test-asdf-system::*times-loaded* 30)
(assert-equal test-package::*file3* :reset)
(DBG "Check that require-system called with untouched .asd won't reload the asdf.")
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
(require-system 'test-asdf/force))
;; Somehow, it loads the system...
(assert-equal test-asdf-system::*times-loaded* 30)
(assert-equal test-package::*file3* :reset)