Newer
Older
(load "script-support.lisp")
(in-package :asdf)
(use-package :asdf-test)
(defparameter *test-directory*
(merge-pathnames* (coerce-pathname "tmp/") *asdf-directory*))
(defun under-test-directory (designator &optional (defaults *test-directory*))
(namestring (merge-pathnames* (coerce-pathname designator) defaults)))
(defun create-conf-files (&optional (path *test-directory*))
(let ((v `(("conf.d/conf1.conf"
((:directory ,(under-test-directory "dir1/"))))
("conf.d/conf2.conf"
Robert P. Goldman
committed
((:tree ,(under-test-directory "dir2/"))))
;; this is for testing the :here directive
("dir5/conf.conf"
Robert P. Goldman
committed
("dir8/conf.conf"
((:directory (:here))))
("dir9/dira/conf.conf"
((:tree (:here)))))))
(loop
:for (file contents) :in v
:for name = (under-test-directory file path)
:do
(ensure-directories-exist name)
(with-open-file (out name
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(format out "~{~S~%~}" contents))))))
(defparameter *test-asd-directories*
(loop
:for dir
:in '("dir1/" ; foo0
"dir2/dir3/" ; foo1
"dir2/dir4/" ; foo2
"dir2/" ; foo3
Robert P. Goldman
committed
;; system here should be found because of :here directive
Robert P. Goldman
committed
;; system here should /not/ be found because of :here directive
"dir5/dir7/" ; foo5
"dir8/" ; foo6
"dir9/dira/" ; foo7 should be found because of :here :tree
"dir9/dira/dirc/" ; foo8 ditto
"dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree
:collect (under-test-directory dir)))
(defun create-asd-files ()
(loop
:for d :in *test-asd-directories*
:for i :from 0 :do
(ensure-directories-exist d)
(with-open-file (s (merge-pathnames* (format nil "foo~D.asd" i) d)
:direction :output
:if-exists :rename-and-delete
:if-does-not-exist :create)
(format s "(defsystem :foo~D)~%" i))))
(asdf-test:quit-on-error
(equal (asdf::parse-output-translations-string "/foo:/bar::/baz:/quux")
'(:output-translations
("/foo" "/bar")
:inherit-configuration
("/baz" "/quux"))))
(assert
(equal (asdf::parse-output-translations-string "/:")
'(: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
(equal (asdf::parse-output-translations-string
"(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)")
'(:output-translations ("/" "/") :ignore-inherited-configuration)))
(create-asd-files)
(create-conf-files)
Francois-Rene Rideau
committed
(format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-test-directory "dir2/")))
(assert (= 2 (length (subdirectories (under-test-directory "dir2/")))))
Robert P. Goldman
committed
(format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-test-directory "dir5/")))
(assert (= 2 (length (subdirectories (under-test-directory "dir5/")))))
;; (trace asdf::process-source-registry)
(initialize-source-registry
`(:source-registry (:include ,(under-test-directory "conf.d/"))
Robert P. Goldman
committed
(:include ,(under-test-directory "dir5/"))
(:include ,(under-test-directory "dir8/"))
(:include ,(under-test-directory "dir9/dira/"))
:ignore-inherited-configuration))
Francois-Rene Rideau
committed
Francois-Rene Rideau
committed
(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))
Robert P. Goldman
committed
(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)))
Francois-Rene Rideau
committed
(format t "~&A: ~S~%B: ~S~%"
(namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(under-test-directory "dir2/bar/baz.lisp"))
(assert
(equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(under-test-directory "dir2/bar/baz.lisp")))
)