Loading .gitignore +4 −0 Original line number Diff line number Diff line Loading @@ -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 Loading test/run-tests.sh +7 −5 Original line number Diff line number Diff line Loading @@ -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]" Loading Loading @@ -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 test/test-source-registry.s +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 Loading
.gitignore +4 −0 Original line number Diff line number Diff line Loading @@ -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 Loading
test/run-tests.sh +7 −5 Original line number Diff line number Diff line Loading @@ -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]" Loading Loading @@ -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
test/test-source-registry.s +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