From bdf412cf5dc2d7fe4982a4ba1a07388e349a6ae8 Mon Sep 17 00:00:00 2001 From: "Rommel M. Martinez" <ebzzry@gmail.com> Date: Thu, 21 Jan 2010 15:25:42 +0800 Subject: [PATCH] Added preliminary test/test-source-registry.script --- test/test-source-registry.script | 96 ++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100644 test/test-source-registry.script diff --git a/test/test-source-registry.script b/test/test-source-registry.script new file mode 100644 index 00000000..8edb6158 --- /dev/null +++ b/test/test-source-registry.script @@ -0,0 +1,96 @@ +(load "script-support") +(load "../asdf") + +;; TODO: +;; - test for conditions + +(defpackage :test-source-registry + (:use #:cl #:asdf)) + +(in-package :test-source-registry) + +(defun getenv (x) + #+sbcl + (sb-posix:getenv x)) + +(defun setenv (x v) + #+sbcl + (sb-posix:putenv + (concatenate 'string x "=" v))) + +(defmacro with-gensyms ((&rest names) &body body) + `(let ,(loop for n in names collect `(,n (gensym))) + ,@body)) + +(defmacro with-env-var ((key value) &rest rest) + (with-gensyms (key-save) + `(let ((,key-save ,(getenv key))) + (unwind-protect + (progn + (setenv ,key ,value) + ,@rest) + (progn + (setenv ,key ,key-save)))))) + +(defun make-temporary-directory () + (let ((str (with-output-to-string (s) + (sb-ext:run-program "mktemp" '("-d") :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 () + (source-registry-under (merge-pathnames ".config/" (home-directory)))) +(defun system-source-registry () + (source-registry-under (system-directory))) + + +(defvar *asd-temp-path-1* + (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 + (:inhert-configuration) + (:directory ,(namestring (tmp-directory))))) + +(defun write-registry-file (file contents) + (with-open-file (out file + :direction :output + :if-exists :supersede) + (with-standard-io-syntax + (format out "~S" contents)))) +(defun write-system-source-registry-config () + (write-registry-file (system-source-registry) + *system-source-registry-config*)) +(defun write-home-source-registry-config () + (write-registry-file (home-source-registry) + *home-source-registry-config*)) + +(defun merge-temp-under (path) + (namestring + (merge-pathnames + (let ((s (string-downcase + (prin1-to-string (gentemp))))) + (concatenate 'string s "/")) + path))) + +;; test environment variable + +;; test files + +(cl-user::quit-on-error + ...) \ No newline at end of file -- GitLab