diff --git a/.gitignore b/.gitignore index 7ba4795c0a62537d32261edf2201129eee9f9184..d3b7b0333276dd280d82c96fb781a02a78f91caf 100644 --- a/.gitignore +++ b/.gitignore @@ -49,6 +49,7 @@ test/try-reloading-dependency.asd test/fileMissing.lisp test/hello-world-example test/test-include.asd +test/test-multiple-too.asd build-stamp diff --git a/test/test-multiple.script b/test/test-multiple.script index e80e2eaf374c7ab36ba5b833389430b30128c188..e93bf365f5748f6890c54f365899c278e9403355 100644 --- a/test/test-multiple.script +++ b/test/test-multiple.script @@ -1,32 +1,52 @@ ;;; -*- Lisp -*- (defparameter asd (subpathname *test-directory* "test-multiple.asd")) -(defparameter tmp (subpathname *test-directory* "../build/")) -(defparameter asd2 (subpathname tmp "test-multiple-too.asd")) +(defparameter asd2 (subpathname *test-directory* "test-multiple-too.asd")) (defparameter file4 (test-fasl "file4")) -(setf *central-registry* `(,*test-directory* ,tmp)) +(setf *central-registry* `(,*test-directory*)) + +;; Don't rely on ln -s because of Windows. +;; Also allows pathname tests to distinguish between asd and asd2 +(delete-file-if-exists asd2) +(concatenate-files (list asd) asd2) ;; don't use copy-file, to ensure the timestamp of asd2 is newer. -;; Don't rely on ln -s on Windows -(defparameter symlinkp - (progn - #+os-unix - (zerop - (nth-value 2 - (run-program - `("ln" "-sf" ,(native-namestring asd) ,(native-namestring asd2)) - :output t :error-output t :input nil :ignore-error-status t))))) (defmacro with-bad-system-names (&body body) `(handler-bind ((bad-system-name #'(lambda (c) (muffle-warning c)))) ,@body)) -(with-bad-system-names - (oos 'load-source-op (if symlinkp 'test-multiple-too 'test-multiple))) -(assert (asymval :*file2* :test-package)) -(with-bad-system-names - (load-system 'test-multiple-free)) -(assert (probe-file* file4)) -(assert (asymval :*file4* :test-package)) -(setf test-package::*file4* nil) -(with-bad-system-names +(with-asdf-session () + (DBG "Loading test-multiple-too, a copy of test-multiple") + (with-bad-system-names + (oos 'load-source-op 'test-multiple-too)) + (assert (asymval :*file2* :test-package)) + (assert (not (asymval :*file4* :test-package))) ;; file4 from test-multiple-free is not loaded + ;; All systems loaded from test-multiple-too.asd + (assert-pathname-equal (system-source-file (registered-system 'test-multiple)) asd2) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-too)) asd2) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-dep)) asd2) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-free)) asd2)) + +(with-asdf-session () + (DBG "Loading test-multiple-free, a badly named secondary system that depends on test-multiple (that was loaded as badly named from test-multiple-too). It shouldn't be found by path, so the existing definition will be used, which will pull test-multiple, which will in turn override test-multiple-too, but test-multiple-free will be locked to the value at the beginning of the session, which uses test-multiple-too.asd (ouch).") + (with-bad-system-names (load-system 'test-multiple-free)) -(assert-equal test-package::*file4* nil) + (assert (probe-file* file4)) + (assert (asymval :*file4* :test-package)) ;; file4 from test-multiple-free is loaded + ;; All systems loaded from test-multiple.asd except test-multiple-free stuck with test-multiple-too.asd + (assert-pathname-equal (system-source-file (registered-system 'test-multiple)) asd) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-too)) asd) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-dep)) asd) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-free)) asd2)) + +(with-asdf-session () + (DBG "Loading test-multiple-free again. [I admit I don't fully understand the behavior -fare]") + (setf test-package::*file4* nil) + (with-bad-system-names + (DBG :l (asdf/plan:plan-actions (nth-value 1 (oos 'load-op 'test-multiple-free))))) + ;; All systems loaded from test-multiple-too.asd [I'm not sure why; it may have to do with timestamp (!) -fare] + (assert-pathname-equal (system-source-file (registered-system 'test-multiple)) asd2) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-too)) asd2) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-dep)) asd2) + (assert-pathname-equal (system-source-file (registered-system 'test-multiple-free)) asd2) + ;; The above unexpected reloading of asd causes file4 to be reloaded + (assert-equal test-package::*file4* t))