From f7716ac1a87649cad96242f2d5bf0a987d7f430c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 7 Mar 2022 15:31:00 +0100 Subject: Add new tests. --- tests/web-server.scm | 61 ---------------------------------------------------- 1 file changed, 61 deletions(-) delete mode 100644 tests/web-server.scm (limited to 'tests/web-server.scm') diff --git a/tests/web-server.scm b/tests/web-server.scm deleted file mode 100644 index 837ca3ab..00000000 --- a/tests/web-server.scm +++ /dev/null @@ -1,61 +0,0 @@ -;;; Commentary: -;; Checks that HTTP server can start correctly, and that at least some -;; endpoints return correct information. -;; -;; NOTE This test, when ran in as `tests/run-tests --only web-server.scm' -;; segfaults on Guile 2.2.7, but not on Guile 3.0.8. This doesn't happen -;; when it's run as one of all tests. -;;; Code: - -(((calp server routes) make-make-routes) - ((web server) run-server) - ((ice-9 threads) call-with-new-thread cancel-thread) - ((web client) http-get) - ((hnh util) let*) - ((web response) response-code response-location) - ((web uri) build-uri uri-path) - ((guile) - socket inet-pton bind make-socket-address setsockopt - AF_INET PF_INET SOL_SOCKET SO_REUSEADDR SOCK_STREAM - ) - ) - - -(define host "127.8.9.5") -(define sock (socket PF_INET SOCK_STREAM 0)) -(setsockopt sock SOL_SOCKET SO_REUSEADDR 1) - -(define-values (port sock) - (let ((addr (inet-pton AF_INET host))) - (let loop ((port 8090)) - (catch 'system-error - (lambda () - (bind sock (make-socket-address AF_INET addr port)) - (values port sock)) - (lambda (err proc fmt args data) - (if (and (not (null? data)) - ;; errno address already in use - (= 98 (car data))) - (loop (1+ port)) - ;; rethrow - (throw err fmt args data))))))) - -(define server-thread - (call-with-new-thread - (lambda () - (run-server (make-make-routes) 'http `(socket: ,sock)) - ;; 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