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

move pathname handling to new util package, and to testing package

Browse source
This commit is contained in:
Helmut Merz 2024-06-03 18:25:12 +02:00
parent 8879a6ffa7
commit d85453096e
6 changed files with 49 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
config.lisp
View file

@ -4,30 +4,10 @@
(defpackage :scopes/config
(:use :common-lisp)
(:export #:base #:make-system-path #:override-keys
#:config-path #:file-path
#:relative-path #:runtime-path #:system-path #:test-path))
(:export #:base #:make-system-path #:override-keys))
(in-package :scopes/config)
(defun relative-path (name &rest 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 &rest more-dirs)
(apply #'system-path sys name "test" more-dirs))
(defun runtime-path (name &rest dirs)
(merge-pathnames (apply #'relative-path name dirs)))
(defclass base ()
((override-keys :reader override-keys
:initform nil

5
scopes-core.asd
View file

@ -7,9 +7,10 @@
:homepage "https://www.cyberconcepts.org"
:description "Core packages of the scopes project."
:depends-on (:alexandria :com.inuoe.jzon :local-time :log4cl :str)
:components ((:file "config")
:components ((:file "config" :depends-on ("util"))
(:file "forge/forge")
(:file "testing")
(:file "util")
(:file "testing" :depends-on ("util"))
(:file "test/test-config" :depends-on ("testing" "config"))
(:file "test/test-forge" :depends-on ("testing" "forge/forge")))
:long-description "scopes/core: The core packages of the scopes project."

5
scopes.asd
View file

@ -8,11 +8,12 @@
:description "Generic data processing."
:depends-on (:alexandria :chanl :cl-dotenv :com.inuoe.jzon :dbi
:local-time :log4cl :str :sxql)
:components ((:file "config")
:components ((:file "config" :depends-on ("util"))
(:file "forge/forge")
(:file "storage/storage")
(:file "storage/tracking" :depends-on ("storage/storage"))
(:file "testing")
(:file "util")
(:file "testing" :depends-on ("util"))
(:file "test/test-config" :depends-on ("testing" "config"))
(:file "test/test-forge" :depends-on ("testing" "forge/forge"))
(:file "test/test-storage"

15
test/test-config.lisp
View file

@ -5,6 +5,7 @@
(defpackage :scopes/test-config
(:use :common-lisp)
(:local-nicknames (:config :scopes/config)
(:util :scopes/util)
(:t :scopes/testing))
(:export #:run)
(:import-from :scopes/testing #:deftest #:==))
@ -24,12 +25,12 @@
(t:show-result)))
(t:deftest test-make-path ()
(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")))
(format t "~&relative-path: ~s" (util:relative-path "config" "app" "etc"))
(format t "~&system-path: ~s" (util:system-path :scopes "config" "test"))
(format t "~&test-path (config): ~s" (t:test-path :scopes "config"))
(format t "~&test-path (data): ~s" (t:test-path :scopes "test.db" "data"))
(format t "~&runtime-path: ~s" (util:runtime-path "config" "app" "etc"))
(format t "~&runtime-path (.env): ~s" (util:runtime-path ".env" "app")))
(t:deftest test-env-override ()
(format t "~%override-keys: ~s" (config:override-keys *config*)))
(format t "~&override-keys: ~s~%" (config:override-keys *config*)))

10
testing.lisp
View file

@ -6,7 +6,8 @@
(:use :common-lisp)
(:export #:*test-suite*
#:test-suite #:deftest #:show-result
#:test #:==))
#:test #:==
#:test-path))
(in-package :scopes/testing)
@ -41,3 +42,10 @@
`(defun ,name ,args
(push '(,name) (result *test-suite*))
,@body))
;;;; utilities
(defun test-path (sys name &rest dirs)
(apply #'scopes/util:system-path sys name "test" dirs))

24
util.lisp Normal file
View file

@ -0,0 +1,24 @@
;;;; clscopes/util
;;;; Common utilities for the scopes project.
(defpackage :scopes/util
(:use :common-lisp)
(:export #:relative-path #:runtime-path #:system-path))
(in-package :scopes/util)
(defun relative-path (name &rest 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 runtime-path (name &rest dirs)
(merge-pathnames (apply #'relative-path name dirs)))
(defun system-path (sys name &rest dirs)
(asdf:system-relative-pathname sys (apply #'relative-path name dirs)))