Commit 5e3ab4dd authored by Rommel M. Martinez's avatar Rommel M. Martinez

Updated source registry test script

parent 67ea58d5
......@@ -8,6 +8,10 @@ website/changelog.xml
# Test stuff
test/results/
test/tmp/
test/conf.d/
test/dir1/
test/dir2/
# We build these at various stages in the make process
LICENSE
......
......@@ -5,8 +5,7 @@
# - quit with exit status 0 on getting eof
# - quit with exit status >0 if an unhandled error occurs
export TEST_DIR="$PWD/tmp/"
export CL_SOURCE_REGISTRY="$TEST_DIR/dir1/:$TEST_DIR/dir2//"
export CL_SOURCE_REGISTRY="$PWD"
if [ x"$1" = "xhelp" ]; then
echo "$0 [lisp invocation] [scripts-regex]"
......@@ -107,21 +106,24 @@ fi
#fi
create_asds () {
mkdir -p tmp/{conf.d,dir1,dir2/{dir3,dir4}}
for i in `find tmp | sed -e '1d;/conf.d/d'`; do touch "$i"/test.asd; done
mkdir -p {conf.d,dir1,dir2/{dir3,dir4}}
for i in dir1 dir2; do touch "$i"/test.asd; done
for i in dir3 dir4; do (cd dir2/$i; touch test.asd); done
}
clean_up () {
rm -rf tmp
rm -rf {conf.d,dir?}
}
if [ -z "$command" ] ; then
echo "Error: cannot find or do not know how to run Lisp named $lisp"
else
create_asds
mkdir -p results
echo $command
thedate=`date "+%Y-%m-%d"`
do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
clean_up
fi
(load "script-support")
(load "../asdf")
;; TODO:
;; - test for directories
;; - test for correct chaining of inheritance
(defun pathname->directory (pathname)
(make-pathname
:directory (append (pathname-directory pathname)
(list (file-namestring pathname)))
:name nil
:type nil
:defaults (pathname pathname)))
(defvar *test-directory*
(pathname->directory (getenv "TEST_DIR")))
(ensure-directory-pathname
(getenv "PWD")))
(defvar *test-conf-directory*
(merge-pathnames "conf.d/" *test-directory*))
(merge-pathnames "conf.d/" (getenv "PWD")))
(defun under-test-directory (path &optional (defaults *test-directory*))
(merge-pathnames path defaults))
(defun ensure-recursive-directory (path)
(concatenate
'string
(namestring
(ensure-directory-pathname path))
"/"))
(defun create-conf-files (&optional (path *test-conf-directory*))
(let ((v `(("conf1.conf"
((:directory ,(namestring (under-test-directory "dir1/")))))
......@@ -29,7 +25,7 @@
((:tree ,(namestring (under-test-directory "dir2/"))))))))
(loop
:for (file contents) :in v :do
(with-open-file (out file
(with-open-file (out (merge-pathnames file path)
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
......@@ -37,29 +33,50 @@
(defvar *test-config-1*
`(:source-registry
(:directory ,(namestring (under-test-directory "dir1/")))
(:tree ,(namestring (under-test-directory "dir2/")))
(:tree ,(getenv "PWD"))
(:ignore-inherited-configuration)))
(defvar *test-expect-1*
(loop
:for dir
:in '("dir1/" "dir2/dir3/" "dir2/dir4/" "dir2/")
:collect (merge-pathnames dir *test-directory*)))
(append
(loop
:for dir
:in '("dir1/" "dir2/dir3/" "dir2/dir4/" "dir2/")
:collect (merge-pathnames dir *test-directory*))
(list *test-directory*)))
(defvar *test-source-registries*
'(test-environment-source-registry
test-something-2
test-environment-source-registry-recursive
test-something-3))
(defun test-environment-source-registry ()
(process-source-registry (getenv "CL_SOURCE_REGISTRY")
:inherit *test-source-registries*))
(defun test-environment-source-registry-recursive ()
(process-source-registry
(ensure-recursive-directory
(getenv "CL_SOURCE_REGISTRY"))
:inherit *test-source-registries*))
(defun test-directory-source-registry
(&optional (directory *test-conf-directory*))
(process-source-registry
(validate-source-registry-directory directory)))
(defun test-something-3 () nil)
(cl-user::quit-on-error
(create-conf-files)
(assert (equal (process-source-registry
(getenv "CL_SOURCE_REGISTRY"))
*test-expect-1*))
(assert (equal (process-source-registry
*test-config-1*)
*test-expect-1*))
(assert (every #'pathname (test-environment-source-registry)))
(assert (every #'pathname (test-environment-source-registry-recursive)))
(assert (equal (test-directory-source-registry) *test-expect-1*))
;; FIXME:
;; (assert (equal (process-source-registry
;; *test-config-1*)
;; *test-expect-1*))
;; FIXME: add more tests
;; (assert (equal ...))
)
\ No newline at end of file
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