summary refs log tree commit diff
path: root/gnu/tests/web.scm
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2021-05-09 21:29:46 +0200
committerMarius Bakke <marius@gnu.org>2021-05-09 21:29:46 +0200
commitf03426420497cd9839f5fb3cb547dbecd8d6053b (patch)
tree220cdbab5b58b27c63d2df3ee711ad4bfdda074b /gnu/tests/web.scm
parent3cf1afb7e7249992b2db2f4f00899fd22237e89a (diff)
parent069399ee9dbf75b7c89583f03346a63b2cfe4ac6 (diff)
downloadguix-f03426420497cd9839f5fb3cb547dbecd8d6053b.tar.gz
Merge branch 'master' into core-updates
 Conflicts:
	gnu/local.mk
	gnu/packages/bioinformatics.scm
	gnu/packages/django.scm
	gnu/packages/gtk.scm
	gnu/packages/llvm.scm
	gnu/packages/python-web.scm
	gnu/packages/python.scm
	gnu/packages/tex.scm
	guix/build-system/asdf.scm
	guix/build/emacs-build-system.scm
	guix/profiles.scm
Diffstat (limited to 'gnu/tests/web.scm')
-rw-r--r--gnu/tests/web.scm61
1 files changed, 34 insertions, 27 deletions
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 7f4518acd2..61575f497d 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -65,6 +65,26 @@
         (lambda (port)
           (display #$%index.html-contents port)))))
 
+(define retry-on-error
+  #~(lambda* (f #:key times delay)
+      (let loop ((attempt 1))
+        (match (catch
+                 #t
+                 (lambda ()
+                   (cons #t
+                         (f)))
+                 (lambda args
+                   (cons #f
+                         args)))
+          ((#t . return-value)
+           return-value)
+          ((#f . error-args)
+           (if (>= attempt times)
+               error-args
+               (begin
+                 (sleep delay)
+                 (loop (+ 1 attempt)))))))))
+
 (define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080))
   "Run tests in %NGINX-OS, which has nginx running and listening on
 HTTP-PORT."
@@ -472,28 +492,9 @@ HTTP-PORT."
                 (start-service 'tailon))
              marionette))
 
-          (define* (retry-on-error f #:key times delay)
-            (let loop ((attempt 1))
-              (match (catch
-                      #t
-                      (lambda ()
-                        (cons #t
-                              (f)))
-                      (lambda args
-                        (cons #f
-                              args)))
-                ((#t . return-value)
-                 return-value)
-                ((#f . error-args)
-                 (if (>= attempt times)
-                     error-args
-                     (begin
-                       (sleep delay)
-                       (loop (+ 1 attempt))))))))
-
           (test-equal "http-get"
             200
-            (retry-on-error
+            (#$retry-on-error
              (lambda ()
                (let-values (((response text)
                              (http-get #$(format
@@ -607,12 +608,14 @@ HTTP-PORT."
   (define vm
     (virtual-machine
      (operating-system os)
-     (port-forwardings `((8080 . ,forwarded-port)))))
+     (port-forwardings `((8080 . ,forwarded-port)))
+     (memory-size 1024)))
 
   (define test
     (with-imported-modules '((gnu build marionette))
       #~(begin
           (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (ice-9 match)
                        (gnu build marionette)
                        (web uri)
                        (web client)
@@ -647,12 +650,16 @@ HTTP-PORT."
 
           (test-equal "http-get"
             200
-            (let-values
-                (((response text)
-                  (http-get #$(simple-format
-                               #f "http://localhost:~A/" forwarded-port)
-                            #:decode-body? #t)))
-              (response-code response)))
+            (#$retry-on-error
+             (lambda ()
+               (let-values
+                   (((response text)
+                     (http-get #$(simple-format
+                                  #f "http://localhost:~A/" forwarded-port)
+                               #:decode-body? #t)))
+                 (response-code response)))
+             #:times 10
+             #:delay 5))
 
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))