From 476234f6c1e32796ac9a1df6dc5e67f7cf4a960e Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Mon, 3 Jun 2024 15:17:09 +0200
Subject: [PATCH] pathname experiments for safe access to config file(s) from
 tests and apps

---
 config.lisp           | 21 +++++++++++++++++++--
 test/test-config.lisp | 18 ++++++++++++++----
 2 files changed, 33 insertions(+), 6 deletions(-)

diff --git a/config.lisp b/config.lisp
index 3d86c8c..399f24f 100644
--- a/config.lisp
+++ b/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)))
diff --git a/test/test-config.lisp b/test/test-config.lisp
index 865be58..4c6e992 100644
--- a/test/test-config.lisp
+++ b/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*)))