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