diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-12 07:36:22 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-12 07:36:22 +0200 |
commit | e78fd7caba9daf44d052f5e67453cd2f74e3d6b8 (patch) | |
tree | b67b3f79a1f84f8d344251619ba108d4b2bf292f /tests | |
parent | Broke away routes from server entry-points. (diff) | |
download | calp-e78fd7caba9daf44d052f5e67453cd2f74e3d6b8.tar.gz calp-e78fd7caba9daf44d052f5e67453cd2f74e3d6b8.tar.xz |
Start adding tests for server.
Diffstat (limited to 'tests')
-rwxr-xr-x | tests/run-tests.scm | 4 | ||||
-rw-r--r-- | tests/web-server.scm | 38 |
2 files changed, 41 insertions, 1 deletions
diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 7eb0bb73..b162522d 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -76,7 +76,9 @@ #:allocation-limit #e10e8 #:module (make-sandbox-module (append modules - '(((srfi srfi-64) test-assert test-equal test-error) + '(((srfi srfi-64) test-assert + test-equal test-error + test-eqv) ((ice-9 ports) call-with-input-string) ((guile) make-struct/no-tail) ) diff --git a/tests/web-server.scm b/tests/web-server.scm new file mode 100644 index 00000000..612911f0 --- /dev/null +++ b/tests/web-server.scm @@ -0,0 +1,38 @@ +(((server routes) make-make-routes) + ((web server) run-server) + ((ice-9 threads) call-with-new-thread cancel-thread) + ((web client) http-get) + ((util) let*) + ((web response) response-code response-location) + ((web uri) build-uri uri-path) + ((guile) AF_INET)) + +;; TODO find some free address. +(define port 8090) +(define host "127.8.9.5") + +(define server-thread + (call-with-new-thread + (lambda () + (run-server (make-make-routes) + 'http + `(family: ,AF_INET + host: ,host + port: ,port + )) + ;; This test should always fail, but should never be run + (test-assert "Server returned unexpectedly" #f) + ))) + +(let* ((response body (http-get (build-uri 'http host: host port: port)))) + (test-eqv "Basic connect" 200 (response-code response))) + +(let* ((response body (http-get (build-uri 'http host: host port: port + path: "/today" + query: "view=week&date=2020-01-04")))) + (test-eqv "Redirect" + 302 (response-code response)) + (test-equal "Fully specified redirect position" + "/week/2020-01-04.html" (uri-path (response-location response)))) + +(cancel-thread server-thread) |