test-mutual-redefinition.script 2.78 KB
Newer Older
1 2
;;-*- Lisp -*-

3 4
(setf *asdf-session* nil)

5
(defun current-system-source-file (x)
6
  (system-source-file (asdf::registered-system x)))
7

8
(with-asdf-session (:override t)
9
  (terpri)
10
  (DBG "Loading test-mutual-redefinition-1")
11 12 13 14 15 16 17
  (let ((warned-p nil))
    (handler-bind ((bad-system-name (lambda (c)
                                      (assert-equal (component-name c) "test-mutual-redefinition-2")
                                      (assert-equal (pathname-name (system-source-file c)) "test-mutual-redefinition-1")
                                      (setf warned-p t))))
      (load-system 'test-mutual-redefinition-1))
    (assert warned-p))
18 19 20 21 22 23 24
  (assert-pathname-equal
   (test-source "test-mutual-redefinition-1.asd")
   (current-system-source-file "test-mutual-redefinition-1"))
  (assert-pathname-equal
   (test-source "test-mutual-redefinition-1.asd")
   (current-system-source-file "test-mutual-redefinition-2"))

25
  (terpri)
26 27 28 29 30 31 32 33 34
  (DBG "Loading test-mutual-redefinition-2 in the same cache session.
Looking for its definition should trigger a DEFINE-OP and cause the asd paths to be affected.")
  (let ((warned-p nil))
    (handler-bind ((bad-system-name (lambda (c)
                                      (assert-equal (component-name c) "test-mutual-redefinition-1")
                                      (assert-equal (pathname-name (system-source-file c)) "test-mutual-redefinition-2")
                                      (setf warned-p t))))
      (load-system 'test-mutual-redefinition-2))
    (assert warned-p))
35
  (assert-pathname-equal
36 37 38 39
   (test-source "test-mutual-redefinition-2.asd")
   (current-system-source-file "test-mutual-redefinition-2"))
  (assert-pathname-equal
   (test-source "test-mutual-redefinition-2.asd")
40
   (current-system-source-file "test-mutual-redefinition-1"))
41 42 43 44 45 46 47 48 49

  (terpri)
  (DBG "Loading test-mutual-redefinition-1 again in the same cache session.
It should be considered already loaded.")
  (let ((warned-p nil))
    (handler-bind ((bad-system-name (lambda (c)
                                      (setf warned-p t))))
      (load-system 'test-mutual-redefinition-2))
    (assert (not warned-p)))
50
  (assert-pathname-equal
51 52 53 54 55
   (test-source "test-mutual-redefinition-2.asd")
   (current-system-source-file "test-mutual-redefinition-2"))
  (assert-pathname-equal
   (test-source "test-mutual-redefinition-2.asd")
   (current-system-source-file "test-mutual-redefinition-1")))
56

57
(with-asdf-session (:override t)
58
  (terpri)
59 60 61 62 63 64 65 66
  (DBG "loading test-mutual-redefinition-2 in a different cache session")
  (load-system 'test-mutual-redefinition-2)
  (assert-pathname-equal
   (test-source "test-mutual-redefinition-2.asd")
   (current-system-source-file "test-mutual-redefinition-2"))
  (assert-pathname-equal
   (test-source "test-mutual-redefinition-2.asd")
   (current-system-source-file "test-mutual-redefinition-1")))