kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

tests: patchwork: Fix it.

Browse Source 
The "http-get" test is sometimes failing because the Web server is not yet
initialized and returns the 500 error code.

Use the retry-or-error procedure, like in the tailon test to do a few retries.

* gnu/tests/web.scm (run-tailon-test): Move "retry-or-error" procedure to the
top level and adapt its call.
(run-patchwork-test): Use it.
This commit is contained in:
Mathieu Othacehe 2021-04-18 09:47:44 +02:00
parent da28f04a5f
commit 3b5c4e6fb2
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 32 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
gnu/tests/web.scm
View File

@ -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)))))