From 8879a6ffa7d44abe6a8e020c2503c9eab37212ce Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Mon, 3 Jun 2024 16:48:04 +0200 Subject: [PATCH] improve pathname handling: correctly handle file types and leading dots --- config.lisp | 12 +++++++++--- test/test-config.lisp | 12 +++++++----- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/config.lisp b/config.lisp index 399f24f..d54c919 100644 --- a/config.lisp +++ b/config.lisp @@ -11,13 +11,19 @@ (in-package :scopes/config) (defun relative-path (name &rest dirs) - (make-pathname :name name :directory (cons :relative dirs))) + (let* ((parts (str:rsplit "." name :limit 2)) + (n (pop parts)) + (type (car parts))) + (when (string= n "") + (setf n name) + (setf type nil)) + (make-pathname :name n :type type :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 test-path (sys name &rest more-dirs) + (apply #'system-path sys name "test" more-dirs)) (defun runtime-path (name &rest dirs) (merge-pathnames (apply #'relative-path name dirs))) diff --git a/test/test-config.lisp b/test/test-config.lisp index 4c6e992..61ba6be 100644 --- a/test/test-config.lisp +++ b/test/test-config.lisp @@ -24,10 +24,12 @@ (t:show-result))) (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"))) + (format t "~&relative-path: ~s" (config:relative-path "config" "app" "etc")) + (format t "~%system-path: ~s" (config:system-path :scopes "config" "test")) + (format t "~%test-path (config): ~s" (config:test-path :scopes "config")) + (format t "~%test-path (data): ~s" (config:test-path :scopes "test.db" "data")) + (format t "~%runtime-path: ~s" (config:runtime-path "config" "app" "etc")) + (format t "~%runtime-path (.env): ~s" (config:runtime-path ".env" "app"))) (t:deftest test-env-override () - (format t "~%override-keys: ~a" (config:override-keys *config*))) + (format t "~%override-keys: ~s" (config:override-keys *config*)))