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

3
(setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*))
4 5
(chdir *test-directory*)
;;(setf *defaut-pathname-defaults* *test-directory*)
6

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

10
(defun force-plan (&rest forcing-options)
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
  (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))
26 27 28

(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force))
29 30
(assert (component-loaded-p 'test-asdf/force))
(assert-equal (asymval :*file3* :test-package) t)
31
(assert-equal (asymval :*file4* :test-package) t)
32
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
33
(assert-equal (asymval :*file3-only-asd-loaded* :asdf-user) 1)
34

35 36 37 38 39 40
(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)
41

42
(reset-session-visited)
43 44
(defparameter *plan* (force-plan :force t))
(DBG "Check that :force t forces the current system but not its dependencies" *plan*)
45 46 47
(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"))))
48

49
(reset-session-visited)
50 51
(defparameter *plan* (force-plan :force :all))
(DBG "Check that :force :all forces the current system and its dependencies" *plan*)
52 53 54 55
(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")))
56

57
(reset-session-visited)
58 59
(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*)
60 61 62 63
(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"))))
64

65
(reset-session-visited)
66 67
(defparameter *plan* (force-plan :force-not :all))
(DBG "Check that :force-not :all means \"all systems\"" *plan*)
68
(assert (null (asdf::plan-actions *plan*)))
69

70
(reset-session-visited)
71 72
(defparameter *plan* (force-plan :force :all :force-not :all))
(DBG "Check that :force-not :all takes precedence over :force" *plan*)
73
(assert (null (asdf::plan-actions *plan*)))
74

75
(reset-session-visited)
76
(defparameter *plan* (force-plan :force :all :force-not '(:test-asdf/force)))
77
(DBG "Check that :force-not with a list takes precedence over :force" *plan*)
78 79 80 81 82 83 84 85 86 87 88
(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"))))
89

90
(reset-session-visited)
91
(let* ((asdf::*immutable-systems* (list-to-hash-set '("test-asdf/force1")))
92 93 94 95
       (*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")))
96
  ;; transitively included via force1 test-asdf/only, which blocks the traversal
97 98 99
  (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")))))
100

101
;; unforced, date should stay same
102
(touch-file "test-asdf.asd" :timestamp date1)
103 104
(touch-file "file1.lisp" :timestamp date1)
(touch-file file1 :timestamp date2)
105 106 107 108
(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
109
(assert-equal (get-file-stamp file1) date2)
110

111

112
(DBG "Check that require-system won't reload")
113 114 115
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
  (require-system 'test-asdf/force1))
116 117 118
(assert-equal (get-file-stamp file1) date2)
(assert-equal test-package::*file1* :modified)

119 120
;;; So far, only loaded things once
(assert-equal test-asdf-system::*times-loaded* 1)
121

122
(DBG "Check that load-system will reload")
123
(reset-session-visited)
124
(setf test-package::*file1* nil)
125
(setf test-asdf-system::*times-loaded* 10)
126
(assert (not test-package::*file1*))
127 128
(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force1))
129
(assert test-package::*file1*)
130 131 132 133 134
;;; 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!
135

136

137
;; forced, it should be later
138
(DBG "Check that force reloading loads again")
139
(setf test-asdf-system::*times-loaded* 20)
140
(reset-session-visited)
141
(setf test-package::*file3* :reset)
142 143
(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force :force :all))
144
(assert-compare (>= (- (get-file-stamp file1) file1-date) 0))
145
(assert-equal test-package::*file3* t)
146
(DBG "Check that test-asdf.asd was loaded each time it was forced")
147
(assert-equal test-asdf-system::*times-loaded* 21)
148
(DBG "Check that file3-only.asd was loaded only twice, with the :force :all")
149
(assert-equal asdf-user::*file3-only-asd-loaded* 2)
150

151

152
(DBG "Check that require-system called with touched .asd won't reload the asdf.")
153
(setf test-asdf-system::*times-loaded* 30)
154
(setf test-package::*file3* :reset)
155
(reset-session-visited)
156 157 158 159 160
(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))
161
(assert-equal test-asdf-system::*times-loaded* 30)
162 163
(assert-equal test-package::*file3* :reset)

164
(DBG "Check that require-system called with untouched .asd won't reload the asdf.")
165 166 167 168
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
  (require-system 'test-asdf/force))
;; Somehow, it loads the system...
169
(assert-equal test-asdf-system::*times-loaded* 30)
170
(assert-equal test-package::*file3* :reset)