Commit 5397c994 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Massage test-multiple to check non-reloading

Test whether ASDF is still confused by misnamed secondary systems:
parent 53f72684
(in-package :test-package) (in-package :test-package)
(assert *file1*) (assert *file1*)
(defparameter *file2* t)
(defvar *f2c* 0) (defvar *f2c* 0)
(incf *f2c*) (incf *f2c*)
;;; -*- Lisp -*- ;;; -*- Lisp -*-
(asdf:defsystem test-multiple (defsystem test-multiple
:components :components
((:file "file3"))) ((:file "file3")))
(asdf:defsystem test-multiple-too (defsystem test-multiple-too
:components :components
((:file "file1") ((:file "file1")
(:file "file2" :depends-on ("file1")) (:file "file2" :depends-on ("file1"))))
(:file "file3" :depends-on ("file1" "file2"))))
(asdf:defsystem test-multiple-free (defsystem test-multiple-free
:depends-on (:test-multiple) :depends-on (:test-multiple :test-multiple-dep)
:components ((:file "file4"))) :components ((:file "file4")))
(defsystem test-multiple-dep
:depends-on (:test-multiple)
:components ((:file "file3")))
...@@ -7,19 +7,19 @@ ...@@ -7,19 +7,19 @@
(setf *central-registry* `(,*test-directory* ,tmp)) (setf *central-registry* `(,*test-directory* ,tmp))
;; Don't rely on ln -s on Windows ;; Don't rely on ln -s on Windows
(cond (defparameter symlinkp
((os-unix-p) (progn
(multiple-value-bind (output error-output return-code) #+os-unix
(uiop:run-program (zerop
(format nil "ln -sf ~A ~A" (nth-value 2
(native-namestring asd) (run-program
(native-namestring asd2)) :ignore-error-status t) `("ln" "-sf" ,(native-namestring asd) ,(native-namestring asd2))
(declare (ignore output error-output)) :output t :error-output t :input nil :ignore-error-status t)))))
(oos 'load-source-op (if (zerop return-code) (oos 'load-source-op (if symlinkp 'test-multiple-too 'test-multiple))
'test-multiple-too (assert (asymval :*file2* :test-package))
(oos 'load-source-op 'test-multiple)))
(assert (asymval :*file3* :test-package))
(load-system 'test-multiple-free) (load-system 'test-multiple-free)
(assert (probe-file* file4)) (assert (probe-file* file4))
(assert (asymval :*file4* :test-package))
(setf test-package::*file4* nil)
(load-system 'test-multiple-free)
(assert-equal test-package::*file4* nil)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment