From 5e3ab4dd09ffff31fd606e567628478238c6dea9 Mon Sep 17 00:00:00 2001 From: "Rommel M. Martinez" <ebzzry@gmail.com> Date: Thu, 28 Jan 2010 23:50:15 +0800 Subject: [PATCH] Updated source registry test script --- .gitignore | 4 ++ test/run-tests.sh | 12 +++--- test/test-source-registry.s | 73 +++++++++++++++++++++++-------------- 3 files changed, 56 insertions(+), 33 deletions(-) diff --git a/.gitignore b/.gitignore index 3f106070..4d74b6b6 100644 --- a/.gitignore +++ b/.gitignore @@ -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 diff --git a/test/run-tests.sh b/test/run-tests.sh index be064e9d..9ee0f9a5 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -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 diff --git a/test/test-source-registry.s b/test/test-source-registry.s index c4e9d33c..61ce457a 100644 --- a/test/test-source-registry.s +++ b/test/test-source-registry.s @@ -1,27 +1,23 @@ (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 -- GitLab