diff options
author | Marius Bakke <marius@gnu.org> | 2021-05-09 21:29:46 +0200 |
---|---|---|
committer | Marius Bakke <marius@gnu.org> | 2021-05-09 21:29:46 +0200 |
commit | f03426420497cd9839f5fb3cb547dbecd8d6053b (patch) | |
tree | 220cdbab5b58b27c63d2df3ee711ad4bfdda074b /gnu/tests/web.scm | |
parent | 3cf1afb7e7249992b2db2f4f00899fd22237e89a (diff) | |
parent | 069399ee9dbf75b7c89583f03346a63b2cfe4ac6 (diff) | |
download | guix-patches-f03426420497cd9839f5fb3cb547dbecd8d6053b.tar guix-patches-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.scm | 61 |
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))))) |