From e78fd7caba9daf44d052f5e67453cd2f74e3d6b8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 12 Aug 2020 07:36:22 +0200
Subject: Start adding tests for server.

---
 tests/run-tests.scm  |  4 +++-
 tests/web-server.scm | 38 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 1 deletion(-)
 create mode 100644 tests/web-server.scm

(limited to 'tests')

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)
-- 
cgit v1.2.3