Skip to content
Snippets Groups Projects
Commit 5e3ab4dd authored by Rommel M. Martinez's avatar Rommel M. Martinez
Browse files

Updated source registry test script

parent 67ea58d5
No related branches found
No related tags found
No related merge requests found
......@@ -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
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment