cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

improve pathname handling: correctly handle file types and leading dots

Browse source
This commit is contained in:
Helmut Merz 2024-06-03 16:48:04 +02:00
parent 476234f6c1
commit 8879a6ffa7
2 changed files with 16 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
config.lisp
View file

@ -11,13 +11,19 @@
(in-package :scopes/config) (in-package :scopes/config)
(defun relative-path (name &rest dirs) (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) (defun system-path (sys name &rest dirs)
(asdf:system-relative-pathname sys (apply #'relative-path name dirs))) (asdf:system-relative-pathname sys (apply #'relative-path name dirs)))
(defun test-path (sys name) (defun test-path (sys name &rest more-dirs)
(system-path sys name "test")) (apply #'system-path sys name "test" more-dirs))
(defun runtime-path (name &rest dirs) (defun runtime-path (name &rest dirs)
(merge-pathnames (apply #'relative-path name dirs))) (merge-pathnames (apply #'relative-path name dirs)))

12
test/test-config.lisp
View file

@ -24,10 +24,12 @@
(t:show-result))) (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 "~&relative-path: ~s" (config:relative-path "config" "app" "etc"))
(format t "~%system-path: ~a" (config:system-path :scopes "config" "test")) (format t "~%system-path: ~s" (config:system-path :scopes "config" "test"))
(format t "~%test-path: ~a" (config:test-path :scopes "config")) (format t "~%test-path (config): ~s" (config:test-path :scopes "config"))
(format t "~%runtime-path: ~a" (config:runtime-path "config" "app" "etc"))) (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 () (t:deftest test-env-override ()
(format t "~%override-keys: ~a" (config:override-keys *config*))) (format t "~%override-keys: ~s" (config:override-keys *config*)))