Loading test/script-support.lisp +7 −1 Original line number Original line Diff line number Diff line Loading @@ -27,7 +27,7 @@ Some constraints: #:leave-test #:def-test-system #:leave-test #:def-test-system #:action-name #:in-plan-p #:action-name #:in-plan-p #:test-source #:test-fasl #:resolve-output #:output-location #:test-source #:test-fasl #:resolve-output #:output-location #:quietly)) #:quietly #:join-namestrings)) (in-package :asdf-test) (in-package :asdf-test) Loading Loading @@ -601,6 +601,12 @@ is bound, write a message and exit on an error. If (assert (asymval '#:*file1* :test-package)) (assert (asymval '#:*file1* :test-package)) (assert (asymval '#:*file3* :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: ;; These are shorthands for interactive debugging of test scripts: (!a (!a common-lisp-user::debug-asdf debug-asdf common-lisp-user::debug-asdf debug-asdf Loading test/test-configuration.script +45 −52 Original line number Original line Diff line number Diff line Loading @@ -50,12 +50,6 @@ "dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree "dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree :collect (under-tmp-directory dir))) :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 () (defun create-asd-files () (loop (loop :for d :in *tmp-asd-directories* :for d :in *tmp-asd-directories* Loading @@ -67,55 +61,54 @@ :if-does-not-exist :create) :if-does-not-exist :create) (format s "(defsystem :foo~D)~%" i)))) (format s "(defsystem :foo~D)~%" i)))) (progn (assert-equal (asdf::parse-output-translations-string (assert-equal (asdf::parse-output-translations-string (join-namestrings '("/foo" "/bar" "" "/baz" "/quux"))) (join-namestrings '("/foo" "/bar" "" "/baz" "/quux"))) '(:output-translations ("/foo" "/bar") :inherit-configuration '(:output-translations ("/foo" "/bar") :inherit-configuration ("/baz" "/quux"))) ("/baz" "/quux"))) (assert-equal (asdf::parse-output-translations-string (assert-equal (asdf::parse-output-translations-string (join-namestrings '("/" ""))) (join-namestrings '("/" ""))) '(:output-translations ("/" nil) :ignore-inherited-configuration)) '(:output-translations ("/" nil) :ignore-inherited-configuration)) (assert-equal (asdf::parse-output-translations-string (assert-equal (asdf::parse-output-translations-string (join-namestrings '("/" "" ""))) (join-namestrings '("/" "" ""))) '(:output-translations ("/" nil) :inherit-configuration)) '(:output-translations ("/" nil) :inherit-configuration)) (assert-equal (asdf::parse-output-translations-string (assert-equal (asdf::parse-output-translations-string (join-namestrings '("/" "/"))) (join-namestrings '("/" "/"))) '(:output-translations ("/" "/") :ignore-inherited-configuration)) '(:output-translations ("/" "/") :ignore-inherited-configuration)) (assert-equal (asdf::parse-output-translations-string (assert-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-tmp-directory "dir2/"))) (format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/"))) (assert-equal 2 (length (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/"))) (format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/"))) (assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/")))) (assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/")))) (initialize-source-registry (initialize-source-registry `(:source-registry (:include ,(under-tmp-directory "conf.d/")) `(:source-registry (:include ,(under-tmp-directory "conf.d/")) (:include ,(under-tmp-directory "dir5/")) (:include ,(under-tmp-directory "dir5/")) (:include ,(under-tmp-directory "dir8/")) (:include ,(under-tmp-directory "dir8/")) (:include ,(under-tmp-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-tmp-directory "dir2/bar/baz.lisp")) (under-tmp-directory "dir2/bar/baz.lisp")) (assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) (assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) (under-tmp-directory "dir2/bar/baz.lisp"))) (under-tmp-directory "dir2/bar/baz.lisp")) test/test-utilities.script +4 −4 Original line number Original line Diff line number Diff line Loading @@ -42,16 +42,16 @@ (assert (assert (not (version-satisfies (asdf-version) "666"))) (not (version-satisfies (asdf-version) "666"))) (assert-pathnames-equal (assert-pathnames-equal (split-native-pathnames-string "foo:bar") (split-native-pathnames-string (join-namestrings '("foo" "bar"))) '(#p"foo" #p"bar")) '(#p"foo" #p"bar")) (assert-pathnames-equal (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/")) '(#p"foo/" #p"bar/")) (assert-pathnames-equal (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")) '(#p"/foo" #p"/bar")) (assert-pathnames-equal (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) :want-absolute t :ensure-directory t) '(#p"/foo/" #p"/bar/")) '(#p"/foo/" #p"/bar/")) (assert-equal (assert-equal Loading Loading
test/script-support.lisp +7 −1 Original line number Original line Diff line number Diff line Loading @@ -27,7 +27,7 @@ Some constraints: #:leave-test #:def-test-system #:leave-test #:def-test-system #:action-name #:in-plan-p #:action-name #:in-plan-p #:test-source #:test-fasl #:resolve-output #:output-location #:test-source #:test-fasl #:resolve-output #:output-location #:quietly)) #:quietly #:join-namestrings)) (in-package :asdf-test) (in-package :asdf-test) Loading Loading @@ -601,6 +601,12 @@ is bound, write a message and exit on an error. If (assert (asymval '#:*file1* :test-package)) (assert (asymval '#:*file1* :test-package)) (assert (asymval '#:*file3* :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: ;; These are shorthands for interactive debugging of test scripts: (!a (!a common-lisp-user::debug-asdf debug-asdf common-lisp-user::debug-asdf debug-asdf Loading
test/test-configuration.script +45 −52 Original line number Original line Diff line number Diff line Loading @@ -50,12 +50,6 @@ "dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree "dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree :collect (under-tmp-directory dir))) :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 () (defun create-asd-files () (loop (loop :for d :in *tmp-asd-directories* :for d :in *tmp-asd-directories* Loading @@ -67,55 +61,54 @@ :if-does-not-exist :create) :if-does-not-exist :create) (format s "(defsystem :foo~D)~%" i)))) (format s "(defsystem :foo~D)~%" i)))) (progn (assert-equal (asdf::parse-output-translations-string (assert-equal (asdf::parse-output-translations-string (join-namestrings '("/foo" "/bar" "" "/baz" "/quux"))) (join-namestrings '("/foo" "/bar" "" "/baz" "/quux"))) '(:output-translations ("/foo" "/bar") :inherit-configuration '(:output-translations ("/foo" "/bar") :inherit-configuration ("/baz" "/quux"))) ("/baz" "/quux"))) (assert-equal (asdf::parse-output-translations-string (assert-equal (asdf::parse-output-translations-string (join-namestrings '("/" ""))) (join-namestrings '("/" ""))) '(:output-translations ("/" nil) :ignore-inherited-configuration)) '(:output-translations ("/" nil) :ignore-inherited-configuration)) (assert-equal (asdf::parse-output-translations-string (assert-equal (asdf::parse-output-translations-string (join-namestrings '("/" "" ""))) (join-namestrings '("/" "" ""))) '(:output-translations ("/" nil) :inherit-configuration)) '(:output-translations ("/" nil) :inherit-configuration)) (assert-equal (asdf::parse-output-translations-string (assert-equal (asdf::parse-output-translations-string (join-namestrings '("/" "/"))) (join-namestrings '("/" "/"))) '(:output-translations ("/" "/") :ignore-inherited-configuration)) '(:output-translations ("/" "/") :ignore-inherited-configuration)) (assert-equal (asdf::parse-output-translations-string (assert-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-tmp-directory "dir2/"))) (format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/"))) (assert-equal 2 (length (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/"))) (format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/"))) (assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/")))) (assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/")))) (initialize-source-registry (initialize-source-registry `(:source-registry (:include ,(under-tmp-directory "conf.d/")) `(:source-registry (:include ,(under-tmp-directory "conf.d/")) (:include ,(under-tmp-directory "dir5/")) (:include ,(under-tmp-directory "dir5/")) (:include ,(under-tmp-directory "dir8/")) (:include ,(under-tmp-directory "dir8/")) (:include ,(under-tmp-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-tmp-directory "dir2/bar/baz.lisp")) (under-tmp-directory "dir2/bar/baz.lisp")) (assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) (assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) (under-tmp-directory "dir2/bar/baz.lisp"))) (under-tmp-directory "dir2/bar/baz.lisp"))
test/test-utilities.script +4 −4 Original line number Original line Diff line number Diff line Loading @@ -42,16 +42,16 @@ (assert (assert (not (version-satisfies (asdf-version) "666"))) (not (version-satisfies (asdf-version) "666"))) (assert-pathnames-equal (assert-pathnames-equal (split-native-pathnames-string "foo:bar") (split-native-pathnames-string (join-namestrings '("foo" "bar"))) '(#p"foo" #p"bar")) '(#p"foo" #p"bar")) (assert-pathnames-equal (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/")) '(#p"foo/" #p"bar/")) (assert-pathnames-equal (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")) '(#p"/foo" #p"/bar")) (assert-pathnames-equal (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) :want-absolute t :ensure-directory t) '(#p"/foo/" #p"/bar/")) '(#p"/foo/" #p"/bar/")) (assert-equal (assert-equal Loading