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

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

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

8 9 10 11 12 13 14
(defun force-plan (&rest forcing-options)
  (asdf::plan-actions
   (asdf::make-plan nil 'load-op 'test-asdf/force
                    :forcing (apply 'asdf::make-forcing :system 'test-asdf/force forcing-options))))

(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force))
15 16
(assert (component-loaded-p 'test-asdf/force))
(assert-equal (asymval :*file3* :test-package) t)
17
(assert-equal (asymval :*file4* :test-package) t)
18
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
19
(assert-equal (asymval :*file3-only-asd-loaded* :asdf-user) 1)
20

21 22 23 24 25 26
(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)
27

28
(reset-session-visited)
29 30 31 32 33
(defparameter *plan* (force-plan :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" "file4")))
(assert (not (asdf::plan-operates-on-p *plan* '("file3-only" "file3"))))
(assert (not (asdf::plan-operates-on-p *plan* '("test-asdf/force1" "file1"))))
34

35
(reset-session-visited)
36 37 38 39 40 41
(defparameter *plan* (force-plan :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" "file4")))
(assert (asdf::plan-operates-on-p *plan* '("file3-only" "file3")))
(assert (asdf::plan-operates-on-p *plan* '("test-asdf/force1" "file1")))
42

43
(reset-session-visited)
44 45 46 47 48 49
(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 *plan*)
(assert (asdf::plan-operates-on-p *plan* '("test-asdf/force" "file4")))
(assert (not (asdf::plan-operates-on-p *plan* '("file3-only" "file3"))))
(assert (not (asdf::plan-operates-on-p *plan* '("test-asdf/force1" "file1"))))
50

51
(reset-session-visited)
52 53 54
(defparameter *plan* (force-plan :force-not :all))
(DBG "Check that :force-not :all means \"all systems\"" *plan*)
(assert (null *plan*))
55

56
(reset-session-visited)
57 58 59
(defparameter *plan* (force-plan :force :all :force-not :all))
(DBG "Check that :force-not :all takes precedence over :force" *plan*)
(assert (null *plan*))
60

61
(reset-session-visited)
62 63 64
(defparameter *plan* (force-plan :force :all :force-not '(:test-asdf/force :test-asdf/force1)))
(DBG "Check that :force-not with a list takes precedence over :force" *plan*)
(assert (null *plan*))
65

66
(reset-session-visited)
67
(let* ((asdf::*immutable-systems* (list-to-hash-set '("test-asdf/force1")))
68
       (plan (force-plan :force :all)))
69 70
  (DBG "Check that immutable-systems will block forcing" plan)
  (assert plan)
71 72 73
  (assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file4")))
  ;; transitively included via force1 test-asdf/only, which blocks the traversal
  (assert (not (asdf::plan-operates-on-p plan '("file3-only" "file3"))))
74
  (assert (not (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1")))))
75

76
;; unforced, date should stay same
77
(touch-file "test-asdf.asd" :timestamp date1)
78 79
(touch-file "file1.lisp" :timestamp date1)
(touch-file file1 :timestamp date2)
80 81 82 83
(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
84
(assert-equal (get-file-stamp file1) date2)
85

86

87
(DBG "Check that require-system won't reload")
88 89 90
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
  (require-system 'test-asdf/force1))
91 92 93
(assert-equal (get-file-stamp file1) date2)
(assert-equal test-package::*file1* :modified)

94

95
(DBG "Check that load-system will reload")
96
(reset-session-visited)
97 98
(setf test-package::*file1* nil)
(assert (not test-package::*file1*))
99 100
(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force1))
101
(assert test-package::*file1*)
102

103

104
;; forced, it should be later
105
(DBG "Check that force reloading loads again")
106
(reset-session-visited)
107
(setf test-package::*file3* :reset)
108 109
(with-asdf-session (:override t :override-forcing t)
  (load-system 'test-asdf/force :force :all))
110
(assert-compare (>= (- (get-file-stamp file1) file1-date) 0))
111 112
(assert-equal test-package::*file3* t)

113 114 115 116 117
(DBG "Check that test-asdf.asd was loaded each time it was forced")
(assert-equal (asymval :*times-loaded* :test-asdf-system) 3)
(DBG "Check that file3-only.asd was loaded only twice, with the :force :all")
(assert-equal (asymval :*file3-only-asd-loaded* :asdf-user) 2)

118

119
(DBG "Check that require-system called with touched .asd won't reload the asdf.")
120
(setf test-package::*file3* :reset)
121
(reset-session-visited)
122 123 124 125 126
(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))
127
(assert-equal (asymval :*times-loaded* :test-asdf-system) 3)
128 129
(assert-equal test-package::*file3* :reset)

130
(DBG "Check that require-system called with untouched .asd won't reload the asdf.")
131 132 133 134
(reset-session-visited)
(with-asdf-session (:override t :override-forcing t)
  (require-system 'test-asdf/force))
;; Somehow, it loads the system...
135
(assert-equal (asymval :*times-loaded* :test-asdf-system) 3)
136
(assert-equal test-package::*file3* :reset)