diff --git a/test/script-support.lisp b/test/script-support.lisp index c318562cd1839af7f6ea089b7e31a4573573658c..df7b8babbdf9806cf973d48e14857ffbdca57a3a 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -27,7 +27,7 @@ Some constraints: #:leave-test #:def-test-system #:action-name #:in-plan-p #:test-source #:test-fasl #:resolve-output #:output-location - #:quietly)) + #:quietly #:join-namestrings)) (in-package :asdf-test) @@ -601,6 +601,12 @@ is bound, write a message and exit on an error. If (assert (asymval '#:*file1* :test-package)) (assert (asymval '#:*file3* :test-package)))) +(defun join-namestrings (namestrings) + (with-output-to-string (s) + (loop :with separator = (acall :inter-directory-separator) + :for (n . morep) :on namestrings + :do (format s "~A~@[~C~]" n (and morep separator))))) + ;; These are shorthands for interactive debugging of test scripts: (!a common-lisp-user::debug-asdf debug-asdf diff --git a/test/test-configuration.script b/test/test-configuration.script index 18252b38f47fdaa8739e729848f2b368f2c30441..c129ee68229122941d3fd938978b525fa0e8e1da 100644 --- a/test/test-configuration.script +++ b/test/test-configuration.script @@ -50,12 +50,6 @@ "dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree :collect (under-tmp-directory dir))) -(defparameter *separator* (inter-directory-separator)) -(defun join-namestrings (namestrings) - (with-output-to-string (s) - (loop :for (n . morep) :on namestrings - :do (format s "~A~@[~C~]" n (and morep *separator*))))) - (defun create-asd-files () (loop :for d :in *tmp-asd-directories* @@ -67,55 +61,54 @@ :if-does-not-exist :create) (format s "(defsystem :foo~D)~%" i)))) -(progn - (assert-equal (asdf::parse-output-translations-string - (join-namestrings '("/foo" "/bar" "" "/baz" "/quux"))) - '(:output-translations ("/foo" "/bar") :inherit-configuration - ("/baz" "/quux"))) - (assert-equal (asdf::parse-output-translations-string - (join-namestrings '("/" ""))) - '(:output-translations ("/" nil) :ignore-inherited-configuration)) - (assert-equal (asdf::parse-output-translations-string - (join-namestrings '("/" "" ""))) - '(:output-translations ("/" nil) :inherit-configuration)) - (assert-equal (asdf::parse-output-translations-string - (join-namestrings '("/" "/"))) - '(:output-translations ("/" "/") :ignore-inherited-configuration)) - (assert-equal (asdf::parse-output-translations-string - "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)") - '(:output-translations ("/" "/") :ignore-inherited-configuration)) +(assert-equal (asdf::parse-output-translations-string + (join-namestrings '("/foo" "/bar" "" "/baz" "/quux"))) + '(:output-translations ("/foo" "/bar") :inherit-configuration + ("/baz" "/quux"))) +(assert-equal (asdf::parse-output-translations-string + (join-namestrings '("/" ""))) + '(:output-translations ("/" nil) :ignore-inherited-configuration)) +(assert-equal (asdf::parse-output-translations-string + (join-namestrings '("/" "" ""))) + '(:output-translations ("/" nil) :inherit-configuration)) +(assert-equal (asdf::parse-output-translations-string + (join-namestrings '("/" "/"))) + '(:output-translations ("/" "/") :ignore-inherited-configuration)) +(assert-equal (asdf::parse-output-translations-string + "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)") + '(:output-translations ("/" "/") :ignore-inherited-configuration)) - (create-asd-files) - (create-conf-files) +(create-asd-files) +(create-conf-files) - (format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/"))) - (assert-equal 2 (length (subdirectories (under-tmp-directory "dir2/")))) +(format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/"))) +(assert-equal 2 (length (subdirectories (under-tmp-directory "dir2/")))) - (format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/"))) - (assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/")))) +(format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/"))) +(assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/")))) - (initialize-source-registry - `(:source-registry (:include ,(under-tmp-directory "conf.d/")) - (:include ,(under-tmp-directory "dir5/")) - (:include ,(under-tmp-directory "dir8/")) - (:include ,(under-tmp-directory "dir9/dira/")) - :ignore-inherited-configuration)) +(initialize-source-registry + `(:source-registry (:include ,(under-tmp-directory "conf.d/")) + (:include ,(under-tmp-directory "dir5/")) + (:include ,(under-tmp-directory "dir8/")) + (:include ,(under-tmp-directory "dir9/dira/")) + :ignore-inherited-configuration)) - (format t "~&Source Registry: ~S~%" - asdf::*source-registry*) - (assert (find-system :foo0 nil)) - (assert (find-system :foo1 nil)) - (assert (find-system :foo2 nil)) - (assert (find-system :foo3 nil)) - (assert (find-system :foo4 nil)) - (assert (not (find-system :foo5 nil))) - (assert (find-system :foo6 nil)) - (assert (find-system :foo7 nil)) - (assert (find-system :foo8 nil)) - (assert (not (find-system :foo9 nil))) +(format t "~&Source Registry: ~S~%" + asdf::*source-registry*) +(assert (find-system :foo0 nil)) +(assert (find-system :foo1 nil)) +(assert (find-system :foo2 nil)) +(assert (find-system :foo3 nil)) +(assert (find-system :foo4 nil)) +(assert (not (find-system :foo5 nil))) +(assert (find-system :foo6 nil)) +(assert (find-system :foo7 nil)) +(assert (find-system :foo8 nil)) +(assert (not (find-system :foo9 nil))) - (format t "~&A: ~S~%B: ~S~%" - (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) - (under-tmp-directory "dir2/bar/baz.lisp")) - (assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) - (under-tmp-directory "dir2/bar/baz.lisp"))) +(format t "~&A: ~S~%B: ~S~%" + (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) + (under-tmp-directory "dir2/bar/baz.lisp")) +(assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) + (under-tmp-directory "dir2/bar/baz.lisp")) diff --git a/test/test-utilities.script b/test/test-utilities.script index a77f1c3562a3a6cf00ba89684891cb70618af747..7bc8d61200275044bdcd11e4dcf58be905add4c7 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -42,16 +42,16 @@ (assert (not (version-satisfies (asdf-version) "666"))) (assert-pathnames-equal - (split-native-pathnames-string "foo:bar") + (split-native-pathnames-string (join-namestrings '("foo" "bar"))) '(#p"foo" #p"bar")) (assert-pathnames-equal - (split-native-pathnames-string "foo:bar" :ensure-directory t) + (split-native-pathnames-string (join-namestrings '("foo" "bar")) :ensure-directory t) '(#p"foo/" #p"bar/")) (assert-pathnames-equal - (split-native-pathnames-string (strcat "/foo" (inter-directory-separator) "/bar") :want-absolute t) + (split-native-pathnames-string (join-namestrings '("/foo" "/bar")) :want-absolute t) '(#p"/foo" #p"/bar")) (assert-pathnames-equal - (split-native-pathnames-string (strcat "/foo" (inter-directory-separator) "/bar") + (split-native-pathnames-string (join-namestrings '("/foo" "/bar")) :want-absolute t :ensure-directory t) '(#p"/foo/" #p"/bar/")) (assert-equal