web/server: move 'demo' handler to test package; core: add tests for util string functions

This commit is contained in:
Helmut Merz 2024-07-05 20:44:17 +02:00
parent 0424b3167c
commit bbe2116d85
4 changed files with 18 additions and 8 deletions

View file

@ -15,7 +15,7 @@
`((("api") server:message-handler) `((("api") server:message-handler)
(() server:fileserver (() server:fileserver
:doc-root ,(t:test-path "" "docs")))) :doc-root ,(t:test-path "" "docs"))))
(config:add-action '(:test :data) #'server:demo) (config:add-action '(:test :data) #'demo)
;(config:add-action '(:test :data) #'(lambda (ctx msg))) ;(config:add-action '(:test :data) #'(lambda (ctx msg)))
(config:add :client :class 'client:config (config:add :client :class 'client:config

View file

@ -52,6 +52,7 @@
(load (t:test-path "config-core" "etc")) (load (t:test-path "config-core" "etc"))
(unwind-protect (unwind-protect
(progn (progn
(test-util)
(core:setup-services) (core:setup-services)
(setf (receiver t:*test-suite*) (core:find-service :test-receiver)) (setf (receiver t:*test-suite*) (core:find-service :test-receiver))
(test-send)) (test-send))
@ -59,6 +60,11 @@
(check-expected) (check-expected)
(t:show-result)))) (t:show-result))))
(deftest test-util ()
(== (util:trunc "hello world" 5) "hello...")
(== (util:trunc "hello world" 11) "hello world")
(== (util:to-keyword "hello-kitty") :hello-kitty))
(deftest test-send () (deftest test-send ()
(let ((rcvr (receiver t:*test-suite*)) (let ((rcvr (receiver t:*test-suite*))
(msg (message:make-message '(:test :dummy) :data "dummy payload")) (msg (message:make-message '(:test :dummy) :data "dummy payload"))

View file

@ -14,6 +14,16 @@
(in-package :scopes/test-web) (in-package :scopes/test-web)
;;;; dummy / test / demo action handlers
(defun demo (ctx msg)
(let ((resp (message:sender msg)))
(if (null resp)
(log:warn "sender missing: ~s" msg)
(setf (server:content resp) "Hello Demo-World!"))))
;;;; test runner
(defun run () (defun run ()
(let ((t:*test-suite* (t:test-suite "web"))) (let ((t:*test-suite* (t:test-suite "web")))
(load (t:test-path "config-web" "etc")) (load (t:test-path "config-web" "etc"))

View file

@ -9,7 +9,7 @@
(:alx :alexandria)) (:alx :alexandria))
(:export #:config #:address #:port #:routes (:export #:config #:address #:port #:routes
#:*listener* #:setup #:start #:stop #:*listener* #:setup #:start #:stop
#:demo #:content
#:fileserver #:message-handler)) #:fileserver #:message-handler))
(in-package :scopes/web/server) (in-package :scopes/web/server)
@ -106,12 +106,6 @@
(let ((ctx (make-instance 'context :config cfg :name (config:name cfg)))) (let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
(start ctx))) (start ctx)))
(defun demo (ctx msg)
(let ((resp (message:sender msg)))
(if (null resp)
(log:warn "sender missing: ~s" msg)
(setf (content resp) "Hello Demo-World!"))))
;;;; helper functions ;;;; helper functions
(defun head (env) (defun head (env)