diff options
| -rw-r--r-- | gnu/tests/web.scm | 58 |
1 files changed, 32 insertions, 26 deletions
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 7f4518acd2..2a6dedc637 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 @@ -613,6 +614,7 @@ HTTP-PORT." (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 +649,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))))) |