test-xach-update-bug.script 2.74 KB
Newer Older
1
;;; -*- Lisp -*-
2

3
(setf asdf/cache:*asdf-cache* nil) ;; disable cache between those two very different compilations.
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
4
(setf asdf::*load-system-operation* 'load-bundle-op) ;; This triggers a bug on ECL no more!
5

6
(defparameter foo :test-asdf-location-change)
7

8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
(with-expected-failure (#+ecl (not (asdf:version-satisfies (lisp-implementation-version) "16"))
                              #-ecl nil)
   (DBG "load foo. Should load from xach-foo-1/")
   (setf *central-registry* (list (subpathname *test-directory* "xach-foo-1/")))
   (defparameter foo1 (find-system foo))
   (assert-pathname-equal
    (subpathname *test-directory* "xach-foo-1/test-asdf-location-change.asd")
    (system-source-file foo1))
   (assert-equal (mapcar 'component-name (component-children foo1)) '("a"))
   (assert-pathname-equal
    (subpathname *test-directory* "xach-foo-1/a.lisp")
    (component-pathname (find-component foo1 "a")))
   (assert-equal nil (find-component foo1 "b"))
   (load-system foo)
   (defparameter loaded (find-symbol* :loaded :first-version))
   (assert-equal (symbol-value loaded) t)
24

25 26 27 28 29
   (DBG "load foo again. Should not do anything -- already loaded")
   (setf (symbol-value loaded) :test-that-we-dont-reload)
   (load-system foo)
   (assert-equal (symbol-value loaded) :test-that-we-dont-reload)
   (assert (not (find-package :second-version)))
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
   (DBG "Now, change registry so foo is found from xach-foo-2/")
   (setf *central-registry* (list (subpathname *test-directory* "xach-foo-2/")))
   (defparameter foo2 (find-system foo))
   (assert (eq foo1 foo2)) ;; the object should be the same
   (assert-equal (mapcar 'component-name (component-children foo2)) '("a" "b"))
   (assert-pathname-equal
    (subpathname *test-directory* "xach-foo-2/test-asdf-location-change.asd")
    (system-source-file foo2))
   (assert-pathname-equal
    (subpathname *test-directory* "xach-foo-2/a.lisp")
    (component-pathname (find-component foo2 "a")))
   (assert-pathname-equal
    (subpathname *test-directory* "xach-foo-2/b.lisp")
    (component-pathname (find-component foo2 "b")))
   (DBG "load foo yet again. It should see the pathname has changed and load it anew")
   ;;; ECL bug: this fails if we use load-bundle-op instead of load-op as *load-system-operation*
   ;;; in bundle.lisp. The test-asdf-location-change.fasb is linked and loaded, but that fails to
   ;;; create the :second-version package; loading the same .fasb in another ecl works fine, and
   ;;; defines (second-version:wtf). WTF? You can test this bug by uncommenting the
   ;;; (setf asdf::*load-system-operation* 'load-bundle-op) line at the beginning of this file.
   ;;; NB: works on MKCL.
   (load-system foo)
   (assert (symbol-value (find-symbol* :loaded :second-version)))
   (assert-equal 42 (symbol-call :second-version :wtf))
)