test-mutual-redefinition.script 3.01 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 9
#+abcl (setf jvm::*resignal-compiler-warnings* t)

10
(with-asdf-session (:override t)
11
  (terpri)
12
  (DBG "Loading test-mutual-redefinition-1")
13 14
  (let ((warned-p nil))
    (handler-bind ((bad-system-name (lambda (c)
15 16
                                      (setf warned-p t)
                                      (format t "Caught bad-system-name condition: ~A~%" c)
17
                                      (assert-equal (component-name c) "test-mutual-redefinition-2")
18
                                      (assert-equal (pathname-name (system-source-file c)) "test-mutual-redefinition-1"))))
19 20
      (load-system 'test-mutual-redefinition-1))
    (assert warned-p))
21 22 23 24 25 26 27
  (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"))

28
  (terpri)
29 30 31 32
  (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)
33 34
                                      (setf warned-p t)
                                      (format t "Caught bad-system-name condition: ~A~%" c)
35
                                      (assert-equal (component-name c) "test-mutual-redefinition-1")
36
                                      (assert-equal (pathname-name (system-source-file c)) "test-mutual-redefinition-2"))))
37 38
      (load-system 'test-mutual-redefinition-2))
    (assert warned-p))
39
  (assert-pathname-equal
40 41 42 43
   (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")
44
   (current-system-source-file "test-mutual-redefinition-1"))
45 46 47 48 49 50 51 52 53

  (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)))
54
  (assert-pathname-equal
55 56 57 58 59
   (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")))
60

61
(with-asdf-session (:override t)
62
  (terpri)
63 64 65 66 67 68 69 70
  (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")))