diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-07-18 10:41:51 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-07-20 11:57:13 +0200 |
commit | 8b113790fa3bfd2300c737901ba161f079fedbdf (patch) | |
tree | 72b7aa4fa9be2a6c129b97b04a11cfbe0d298a79 /gnu/tests/web.scm | |
parent | ed419fa0c56e6ff3aa8bd8e8f100a81442c51e6d (diff) | |
download | guix-8b113790fa3bfd2300c737901ba161f079fedbdf.tar.gz |
tests: Use 'virtual-machine' records instead of monadic procedures.
* gnu/tests/base.scm (%test-basic-os): Use 'let*' instead of 'mlet*' and 'virtual-machine' instead of 'system-qemu-image/shared-store-script'. (run-mcron-test): Likewise. (run-nss-mdns-test): Likewise. * gnu/tests/dict.scm (run-dicod-test): Likewise. * gnu/tests/mail.scm (run-opensmtpd-test): Likewise. (run-exim-test): Likewise. * gnu/tests/messaging.scm (run-xmpp-test): Likewise. * gnu/tests/networking.scm (run-inetd-test): Likewise. * gnu/tests/nfs.scm (run-nfs-test): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/web.scm (run-nginx-test): Likewise.
Diffstat (limited to 'gnu/tests/web.scm')
-rw-r--r-- | gnu/tests/web.scm | 125 |
1 files changed, 62 insertions, 63 deletions
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index bc7e3b89a9..3fa272c676 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -27,7 +27,6 @@ #:use-module (gnu services networking) #:use-module (guix gexp) #:use-module (guix store) - #:use-module (guix monads) #:export (%test-nginx)) (define %index.html-contents @@ -65,68 +64,68 @@ (define* (run-nginx-test #:optional (http-port 8042)) "Run tests in %NGINX-OS, which has nginx running and listening on HTTP-PORT." - (mlet* %store-monad ((os -> (marionette-operating-system - %nginx-os - #:imported-modules '((gnu services herd) - (guix combinators)))) - (command (system-qemu-image/shared-store-script - os #:graphic? #f))) - (define test - (with-imported-modules '((gnu build marionette)) - #~(begin - (use-modules (srfi srfi-11) (srfi srfi-64) - (gnu build marionette) - (web uri) - (web client) - (web response)) - - (define marionette - ;; Forward the guest's HTTP-PORT, where nginx is listening, to - ;; port 8080 in the host. - (make-marionette (list #$command "-net" - (string-append - "user,hostfwd=tcp::8080-:" - #$(number->string http-port))))) - - (mkdir #$output) - (chdir #$output) - - (test-begin "nginx") - - ;; Wait for nginx to be up and running. - (test-eq "service running" - 'running! - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (start-service 'nginx) - 'running!) - marionette)) - - ;; Make sure the PID file is created. - (test-assert "PID file" - (marionette-eval - '(file-exists? "/var/run/nginx/pid") - marionette)) - - ;; Retrieve the index.html file we put in /srv. - (test-equal "http-get" - '(200 #$%index.html-contents) - (let-values (((response text) - (http-get "http://localhost:8080/index.html" - #:decode-body? #t))) - (list (response-code response) text))) - - ;; There should be a log file in here. - (test-assert "log file" - (marionette-eval - '(file-exists? "/var/log/nginx/access.log") - marionette)) - - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) - - (gexp->derivation "nginx-test" test))) + (define os + (marionette-operating-system + %nginx-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((8080 . ,http-port))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette) + (web uri) + (web client) + (web response)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "nginx") + + ;; Wait for nginx to be up and running. + (test-eq "service running" + 'running! + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'nginx) + 'running!) + marionette)) + + ;; Make sure the PID file is created. + (test-assert "PID file" + (marionette-eval + '(file-exists? "/var/run/nginx/pid") + marionette)) + + ;; Retrieve the index.html file we put in /srv. + (test-equal "http-get" + '(200 #$%index.html-contents) + (let-values (((response text) + (http-get "http://localhost:8080/index.html" + #:decode-body? #t))) + (list (response-code response) text))) + + ;; There should be a log file in here. + (test-assert "log file" + (marionette-eval + '(file-exists? "/var/log/nginx/access.log") + marionette)) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "nginx-test" test)) (define %test-nginx (system-test |