pathname experiments for safe access to config file(s) from tests and apps

config.lisp

@@ -4,8 +4,25 @@
 
 (defpackage :scopes/config
   (:use :common-lisp)
-  (:export #:base #:make-system-path))
+  (:export #:base #:make-system-path #:override-keys
+           #:config-path #:file-path 
+           #:relative-path #:runtime-path #:system-path #:test-path))
 
 (in-package :scopes/config)
 
-(defclass base () ())
+(defun relative-path (name &rest dirs)
+  (make-pathname :name name :directory (cons :relative dirs)))
+
+(defun system-path (sys name &rest dirs)
+  (asdf:system-relative-pathname sys (apply #'relative-path name dirs)))
+
+(defun test-path (sys name)
+  (system-path sys name "test"))
+
+(defun runtime-path (name &rest dirs)
+  (merge-pathnames (apply #'relative-path name dirs)))
+
+(defclass base () 
+  ((override-keys :reader override-keys 
+                  :initform nil 
+                  :allocation :class)))

test/test-config.lisp

@@ -11,13 +11,23 @@
 
 (in-package :scopes/test-config)
 
-(defclass config (config:base) 
-  ((override-keys :initform '(user password) :reader override-keys
-                  :allocation :class)))
+(defvar *config* nil)
+
+(defclass test-config (config:base) 
+  ((config:override-keys :initform '(user password))))
 
 (defun run ()
   (let ((t:*test-suite* (t:test-suite "config")))
+    (setf *config* (make-instance 'test-config))
     (test-make-path)
+    (test-env-override)
     (t:show-result)))
 
-(t:deftest test-make-path ())
+(t:deftest test-make-path ()
+  (format t "~%relative-path: ~a" (config:relative-path "config" "app" "etc"))
+  (format t "~%system-path: ~a" (config:system-path :scopes "config" "test"))
+  (format t "~%test-path: ~a" (config:test-path :scopes "config"))
+  (format t "~%runtime-path: ~a" (config:runtime-path "config" "app" "etc")))
+
+(t:deftest test-env-override ()
+  (format t "~%override-keys: ~a" (config:override-keys *config*)))