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

Updated source-registry tests

parent 7e34af2c
No related branches found
No related tags found
No related merge requests found
...@@ -7,6 +7,7 @@ website/changelog.xml ...@@ -7,6 +7,7 @@ website/changelog.xml
# Test stuff # Test stuff
test/results/ test/results/
test/tmp/
# We build these at various stages in the make process # We build these at various stages in the make process
LICENSE LICENSE
......
...@@ -5,7 +5,8 @@ ...@@ -5,7 +5,8 @@
# - quit with exit status 0 on getting eof # - quit with exit status 0 on getting eof
# - quit with exit status >0 if an unhandled error occurs # - quit with exit status >0 if an unhandled error occurs
export CL_SOURCE_REGISTRY=$PWD export TEST_DIR="$PWD/tmp/"
export CL_SOURCE_REGISTRY="$TEST_DIR/dir1/:$TEST_DIR/dir2//"
if [ x"$1" = "xhelp" ]; then if [ x"$1" = "xhelp" ]; then
echo "$0 [lisp invocation] [scripts-regex]" echo "$0 [lisp invocation] [scripts-regex]"
...@@ -105,6 +106,15 @@ fi ...@@ -105,6 +106,15 @@ fi
# do_tests "/usr/bin/lisp -batch -noinit" x86f # do_tests "/usr/bin/lisp -batch -noinit" x86f
#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
}
clean_up () {
rm -rf tmp
}
if [ -z "$command" ] ; then if [ -z "$command" ] ; then
echo "Error: cannot find or do not know how to run Lisp named $lisp" echo "Error: cannot find or do not know how to run Lisp named $lisp"
......
...@@ -2,120 +2,47 @@ ...@@ -2,120 +2,47 @@
(load "../asdf") (load "../asdf")
;; TODO: ;; TODO:
;; - test for conditions ;; - test for directories
;; - use with-env for CL_SOURCE_REGISTRY ;; - test for correct chaining of inheritance
;; - write clean-up procedures, if needed
(eval-when (:execute :compile-toplevel :load-toplevel) (defun pathname->directory (pathname)
(require :sb-posix)) (make-pathname
:directory (append (pathname-directory pathname)
(list (file-namestring pathname)))
:name nil
:type nil
:defaults (pathname pathname)))
(defpackage :test-source-registry (defvar *test-directory*
(:use #:cl #:asdf)) (pathname->directory (getenv "TEST_DIR")))
(in-package :test-source-registry) (defun under-test-directory (path &optional (defaults *test-directory*))
(merge-pathnames path defaults))
(defun getenv (x) (defvar *test-config-1*
#+sbcl
(sb-posix:getenv x))
(defun setenv (x v)
#+sbcl
(sb-posix:putenv
(concatenate 'string x "=" v))
v)
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,@body))
(defmacro with-env ((&rest kv) &body body)
(let ((temps (loop :for i :upto (length kv) :collect (gensym)))
(keys (mapcar #'(lambda (x) (first x)) kv)))
(flet ((gen-getenvs ()
(mapcar #'(lambda (x y)
`(,y (getenv ,x)))
keys temps))
(gen-setenvs ()
(mapcar #'(lambda (x y) `(setenv ,y ,x))
temps keys)))
`(let ,(gen-getenvs)
(unwind-protect
(progn
,@(loop :for (k v) :in kv :collect `(setenv ,k ,v))
,@body)
(progn ,@(gen-setenvs)))))))
(defun make-temporary-directory ()
(let ((str (with-output-to-string (s)
(sb-ext:run-program "mktemp" '("-d" "-u") :search t :output s))))
(concatenate 'string
(string-trim '(#\newline) str) "/")))
(defvar *base-directory* (make-temporary-directory))
(defun home-directory (&optional (base *base-directory*))
(let ((s (namestring (user-homedir-pathname))))
(merge-pathnames (subseq s 1 (length s)) base)))
(defun system-directory (&optional (base *base-directory*))
(merge-pathnames "etc/" base))
(defun tmp-directory (&optional (base *base-directory*))
(merge-pathnames "tmp/" base))
(defun home-source-registry ()
(asdf::source-registry-under (merge-pathnames ".config/" (home-directory))))
(defun system-source-registry ()
(asdf::source-registry-under (system-directory)))
(defun merge-temp-under (path)
(namestring
(merge-pathnames
(let ((s (string-downcase
(prin1-to-string (gentemp)))))
(concatenate 'string s "/"))
path)))
(defvar *asd-temp-path-1*
(merge-temp-under
(merge-temp-under (tmp-directory))))
(defvar *system-source-registry-config*
`(:source-registry
(:inherit-configuration)
(:tree ,*asd-temp-path-1*)))
(defvar *asd-temp-path-2*
(namestring (tmp-directory)))
(defvar *home-source-registry-config*
`(:source-registry `(:source-registry
(:inhert-configuration) (:directory ,(namestring (under-test-directory "dir1/")))
(:directory ,(namestring (tmp-directory))))) (:tree ,(namestring (under-test-directory "dir2/")))
(:ignore-inherited-configuration)))
(defun write-registry-file (path contents)
(ensure-directories-exist path) (defvar *test-expect-1*
(with-open-file (out path (loop
:direction :output :for dir
:if-exists :supersede) :in '("dir1/" "dir2/dir3/" "dir2/dir4/" "dir2/")
(with-standard-io-syntax :collect (merge-pathnames dir *test-directory*)))
(format out "~S" contents))))
(defun write-system-source-registry-config (defvar *test-source-registries*
(&key (path (system-source-registry)) (contents *system-source-registry-config*)) '(test-environment-source-registry
(write-registry-file path contents)) test-something-2
(defun write-home-source-registry-config test-something-3))
(&key (path (home-source-registry)) (contents *home-source-registry-config*))
(write-registry-file path contents)) (cl-user::quit-on-error
(assert (equal (process-source-registry
;; use *asd-temp-path-X*? (getenv "CL_SOURCE_REGISTRY"))
(defun create-asd-file (&optional (directory *default-pathname-defaults*)) *test-expect-1*))
(let ((*default-pathname-defaults* directory)) (assert (equal (process-source-registry
(with-open-file (out *test-config-1*)
*test-expect-1*))
;; FIXME: add more tests
;; test environment variable ;; (assert (equal ...))
(defun test-environment () )
(with-env-var (("CL_SOURCE_REGISTRY" \ No newline at end of file
(format nil "~A:~A" (home-directory) (system-directory))))
...))
;; test files
(defun test-files ()
...)
;; (cl-user::quit-on-error
;; ...)
\ 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