web/server: move 'demo' handler to test package; core: add tests for util string functions
This commit is contained in:
parent
0424b3167c
commit
bbe2116d85
4 changed files with 18 additions and 8 deletions
|
@ -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
|
||||||
|
|
|
@ -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"))
|
||||||
|
|
|
@ -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"))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Add table
Reference in a new issue