Commit 47a234ba authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Fix test-configuration to use tmp directory again.

parent 56f6cf93
...@@ -7,6 +7,7 @@ ...@@ -7,6 +7,7 @@
#:load-asdf-lisp #:compile-asdf #:load-asdf-fasl #:compile-load-asdf #:load-asdf-system #:load-asdf-lisp #:compile-asdf #:load-asdf-fasl #:compile-load-asdf #:load-asdf-system
#:quit-on-error #:test-asdf #:quit-on-error #:test-asdf
#:native-namestring #:native-namestring
#:assert-equal
#:exit-lisp #:leave-lisp #:exit-lisp #:leave-lisp
#:quietly)) #:quietly))
......
...@@ -6,14 +6,17 @@ ...@@ -6,14 +6,17 @@
(use-package :asdf-test) (use-package :asdf-test)
#+gcl<2.7 (defmacro with-standard-io-syntax (&body body) `(progn ,@body)) #+gcl<2.7 (defmacro with-standard-io-syntax (&body body) `(progn ,@body))
(defun under-test-directory (designator &optional (defaults *test-directory*)) (defparameter *tmp-directory* (subpathname *asdf-directory* "tmp/"))
(setf *central-registry* nil)
(defun under-tmp-directory (designator &optional (defaults *tmp-directory*))
(namestring (subpathname defaults designator))) (namestring (subpathname defaults designator)))
(defun create-conf-files (&optional (path *test-directory*)) (defun create-conf-files (&optional (path *tmp-directory*))
(let ((v `(("conf.d/conf1.conf" (let ((v `(("conf.d/conf1.conf"
((:directory ,(under-test-directory "dir1/")))) ((:directory ,(under-tmp-directory "dir1/"))))
("conf.d/conf2.conf" ("conf.d/conf2.conf"
((:tree ,(under-test-directory "dir2/")))) ((:tree ,(under-tmp-directory "dir2/"))))
;; this is for testing the :here directive ;; this is for testing the :here directive
("dir5/conf.conf" ("dir5/conf.conf"
((:directory (:here "dir6")))) ((:directory (:here "dir6"))))
...@@ -23,7 +26,7 @@ ...@@ -23,7 +26,7 @@
((:tree (:here))))))) ((:tree (:here)))))))
(loop (loop
:for (file contents) :in v :for (file contents) :in v
:for name = (under-test-directory file path) :for name = (under-tmp-directory file path)
:do :do
(ensure-directories-exist name) (ensure-directories-exist name)
(with-open-file (out name (with-open-file (out name
...@@ -32,7 +35,7 @@ ...@@ -32,7 +35,7 @@
(with-standard-io-syntax (with-standard-io-syntax
(format out "~{~S~%~}" contents)))))) (format out "~{~S~%~}" contents))))))
(defparameter *test-asd-directories* (defparameter *tmp-asd-directories*
(loop (loop
:for dir :for dir
:in '("dir1/" ; foo0 :in '("dir1/" ; foo0
...@@ -47,11 +50,11 @@ ...@@ -47,11 +50,11 @@
"dir9/dira/" ; foo7 should be found because of :here :tree "dir9/dira/" ; foo7 should be found because of :here :tree
"dir9/dira/dirc/" ; foo8 ditto "dir9/dira/dirc/" ; foo8 ditto
"dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree "dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree
:collect (under-test-directory dir))) :collect (under-tmp-directory dir)))
(defun create-asd-files () (defun create-asd-files ()
(loop (loop
:for d :in *test-asd-directories* :for d :in *tmp-asd-directories*
:for i :from 0 :do :for i :from 0 :do
(ensure-directories-exist d) (ensure-directories-exist d)
(with-open-file (s (merge-pathnames* (format nil "foo~D.asd" i) d) (with-open-file (s (merge-pathnames* (format nil "foo~D.asd" i) d)
...@@ -60,62 +63,52 @@ ...@@ -60,62 +63,52 @@
:if-does-not-exist :create) :if-does-not-exist :create)
(format s "(defsystem :foo~D)~%" i)))) (format s "(defsystem :foo~D)~%" i))))
(asdf-test:quit-on-error (quit-on-error
(assert-equal (asdf::parse-output-translations-string "/foo:/bar::/baz:/quux")
(assert '(:output-translations ("/foo" "/bar") :inherit-configuration
(equal (asdf::parse-output-translations-string "/foo:/bar::/baz:/quux") ("/baz" "/quux")))
'(:output-translations (assert-equal (asdf::parse-output-translations-string "/:")
("/foo" "/bar") '(:output-translations ("/" nil) :ignore-inherited-configuration))
:inherit-configuration (assert-equal (asdf::parse-output-translations-string "/::")
("/baz" "/quux")))) '(:output-translations ("/" nil) :inherit-configuration))
(assert (assert-equal (asdf::parse-output-translations-string "/:/")
(equal (asdf::parse-output-translations-string "/:") '(:output-translations ("/" "/") :ignore-inherited-configuration))
'(:output-translations ("/" nil) :ignore-inherited-configuration)))
(assert
(equal (asdf::parse-output-translations-string "/::")
'(:output-translations ("/" nil) :inherit-configuration)))
(assert
(equal (asdf::parse-output-translations-string "/:/")
'(:output-translations ("/" "/") :ignore-inherited-configuration)))
(assert (assert-equal (asdf::parse-output-translations-string
(equal (asdf::parse-output-translations-string "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)")
"(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)") '(:output-translations ("/" "/") :ignore-inherited-configuration))
'(:output-translations ("/" "/") :ignore-inherited-configuration)))
(create-asd-files) (create-asd-files)
(create-conf-files) (create-conf-files)
(format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-test-directory "dir2/"))) (format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/")))
(assert (= 2 (length (subdirectories (under-test-directory "dir2/"))))) (assert-equal 2 (length (subdirectories (under-tmp-directory "dir2/"))))
(format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-test-directory "dir5/"))) (format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/")))
(assert (= 2 (length (subdirectories (under-test-directory "dir5/"))))) (assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/"))))
(initialize-source-registry (initialize-source-registry
`(:source-registry (:include ,(under-test-directory "conf.d/")) `(:source-registry (:include ,(under-tmp-directory "conf.d/"))
(:include ,(under-test-directory "dir5/")) (:include ,(under-tmp-directory "dir5/"))
(:include ,(under-test-directory "dir8/")) (:include ,(under-tmp-directory "dir8/"))
(:include ,(under-test-directory "dir9/dira/")) (:include ,(under-tmp-directory "dir9/dira/"))
:ignore-inherited-configuration)) :ignore-inherited-configuration))
(format t "~&Source Registry: ~S~%" (format t "~&Source Registry: ~S~%"
asdf::*source-registry*) asdf::*source-registry*)
(assert (find-system :foo0 nil)) (assert (find-system :foo0 nil))
(assert (find-system :foo1 nil)) (assert (find-system :foo1 nil))
(assert (find-system :foo2 nil)) (assert (find-system :foo2 nil))
(assert (find-system :foo3 nil)) (assert (find-system :foo3 nil))
(assert (find-system :foo4 nil)) (assert (find-system :foo4 nil))
(assert (not (find-system :foo5 nil))) (assert (not (find-system :foo5 nil)))
(assert (find-system :foo6 nil)) (assert (find-system :foo6 nil))
(assert (find-system :foo7 nil)) (assert (find-system :foo7 nil))
(assert (find-system :foo8 nil)) (assert (find-system :foo8 nil))
(assert (not (find-system :foo9 nil))) (assert (not (find-system :foo9 nil)))
(format t "~&A: ~S~%B: ~S~%" (format t "~&A: ~S~%B: ~S~%"
(namestring (system-relative-pathname :foo3 "bar/baz.lisp")) (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(under-test-directory "dir2/bar/baz.lisp")) (under-tmp-directory "dir2/bar/baz.lisp"))
(assert (assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) (under-tmp-directory "dir2/bar/baz.lisp")))
(under-test-directory "dir2/bar/baz.lisp")))
)
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