Commit 0ff4c39e authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Merge branches 'master' and 'master' of...

Merge branches 'master' and 'master' of ssh://frideau@common-lisp.net/project/xcvb/git/asdf; branch 'master' of http://common-lisp.net/project/asdf/asdf
parents 08149c40 5e3ab4dd
Loading
Loading
Loading
Loading
+4 −0
Original line number Diff line number Diff line
@@ -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
+7 −5
Original line number Diff line number Diff line
@@ -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/{dir1,dir2/{dir3,dir4}}
    for i in `find tmp | sed -e '1d'`; 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
 
+60 −26
Original line number Diff line number Diff line
(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/" (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/")))))
             ("conf2.conf"
              ((:tree ,(namestring (under-test-directory "dir2/"))))))))
    (loop
     :for (file contents) :in v :do
     (with-open-file (out (merge-pathnames file path)
                          :direction :output
                          :if-exists :supersede)
       (with-standard-io-syntax
         (format out "~{~S~}" contents))))))

(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*
  (append
   (loop
    :for dir
    :in '("dir1/" "dir2/dir3/" "dir2/dir4/" "dir2/")
   :collect (merge-pathnames dir *test-directory*)))
    :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))

(cl-user::quit-on-error
 (assert (equal (process-source-registry
(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"))
                *test-expect-1*))
 (assert (equal (process-source-registry
                 *test-config-1*)
                *test-expect-1*))
   :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 (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