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

remove ugly t: from deftest declarations

Browse source
This commit is contained in:
Helmut Merz 2024-06-23 16:11:22 +02:00
parent 1f3247e1e3
commit 05747fa5cc
5 changed files with 9 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
test/test-config.lisp
View file

@ -32,12 +32,12 @@
(test-env-override) (test-env-override)
(t:show-result))) (t:show-result)))
(t:deftest test-make-path () (deftest test-make-path ()
;(format t "~&runtime-path (.env): ~s" (util:runtime-path ".env" "app")) ;(format t "~&runtime-path (.env): ~s" (util:runtime-path ".env" "app"))
;(format t "~&home-path: ~s" (util:home-path ".env.txt" "lisp" "cl-scopes")) ;(format t "~&home-path: ~s" (util:home-path ".env.txt" "lisp" "cl-scopes"))
(== (pathname-name (util:home-path ".env.txt" "lisp" "cl-scopes")) ".env")) (== (pathname-name (util:home-path ".env.txt" "lisp" "cl-scopes")) ".env"))
(t:deftest test-env-override () (deftest test-env-override ()
(let ((data (config:env-data *config*)) (let ((data (config:env-data *config*))
(child (car (config:children *config*)))) (child (car (config:children *config*))))
(== (gethash :user data) "user-from-env-file") (== (gethash :user data) "user-from-env-file")

2
test/test-core.lisp
View file

@ -59,7 +59,7 @@
(check-expected) (check-expected)
(t:show-result))) (t:show-result)))
(t:deftest test-send () (deftest test-send ()
(let ((rcvr (receiver t:*test-suite*)) (let ((rcvr (receiver t:*test-suite*))
(msg (message:simple-message '(:test :dummy) "dummy payload")) (msg (message:simple-message '(:test :dummy) "dummy payload"))
(msg-exp (message:simple-message '(:test :dummy) "dummy payload"))) (msg-exp (message:simple-message '(:test :dummy) "dummy payload")))

4
test/test-storage.lisp
View file

@ -9,7 +9,7 @@
(:t :scopes/testing)) (:t :scopes/testing))
(:export #:*db-config-test* (:export #:*db-config-test*
#:run #:run-all #:run-postgres #:run-sqlite) #:run #:run-all #:run-postgres #:run-sqlite)
(:import-from :scopes/testing #:==)) (:import-from :scopes/testing #:deftest #:==))
(in-package :scopes/test-storage) (in-package :scopes/test-storage)
@ -38,7 +38,7 @@
(test-track st) (test-track st)
(t:show-result))) (t:show-result)))
(t:deftest test-track (st) (deftest test-track (st)
(let (cont tr tr2 (data (make-hash-table))) (let (cont tr tr2 (data (make-hash-table)))
(setf cont (make-instance 'tracking:container :storage st)) (setf cont (make-instance 'tracking:container :storage st))
(defparameter cl-user::*cont cont) (defparameter cl-user::*cont cont)

6
test/test-web.lisp
View file

@ -30,14 +30,14 @@
(server:stop (core:find-service :server)) (server:stop (core:find-service :server))
(t:show-result)))) (t:show-result))))
(t:deftest test-server-config (server) (deftest test-server-config (server)
(== (parse-integer (server:port (core:config server))) 8899)) (== (parse-integer (server:port (core:config server))) 8899))
(t:deftest test-fileserver (client) (deftest test-fileserver (client)
(let ((msg (message:simple-message '(:test :get-page) '(:path "demo.html")))) (let ((msg (message:simple-message '(:test :get-page) '(:path "demo.html"))))
(== (client:base-url (core:config client)) "http://localhost:8899") (== (client:base-url (core:config client)) "http://localhost:8899")
(has-prefix (client:get-page client msg) "Hello Fileserver!"))) (has-prefix (client:get-page client msg) "Hello Fileserver!")))
(t:deftest test-message (client) (deftest test-message (client)
(let ((msg (message:simple-message '(:test :data)))) (let ((msg (message:simple-message '(:test :data))))
(== (client:send-message client msg) "Hello World!"))) (== (client:send-message client msg) "Hello World!")))

3
web/server.lisp
View file

@ -50,14 +50,13 @@
(dolist (r (routes (core:config ctx))) (dolist (r (routes (core:config ctx)))
(when (match (car r) path) (when (match (car r) path)
(setf (getf env :message-head) (nthcdr (length (car r)) path)) (setf (getf env :message-head) (nthcdr (length (car r)) path))
;(format t "~&route: ~s~%" r)
(return-from select-app (return-from select-app
#'(lambda () #'(lambda ()
(apply (cadr r) ctx env (cddr r))))))) (apply (cadr r) ctx env (cddr r)))))))
#'(lambda () (message-handler ctx env))) #'(lambda () (message-handler ctx env)))
(defun match (pattern path) (defun match (pattern path)
;(format t "~&match: pattern ~s, p ~s" pattern p) ;(format t "~&match: pattern ~s, path ~s" pattern path)
(dolist (e pattern) (dolist (e pattern)
(unless (string= e (pop path)) (unless (string= e (pop path))
(return-from match nil))) (return-from match nil)))