1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
Forwarded: https://codeberg.org/guile/fibers/pulls/156
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 5 Nov 2025 21:09:46 +0100
Subject: [PATCH] tests: Test web server once it is listening.
* tests/concurrent-web-server.scm (wait-for-port): New procedure.
<top level>: Use it.
Fixes: guile/fibers#118
Reported-by: Simon Josefsson <simon@josefsson.org>
---
tests/concurrent-web-server.scm | 27 +++++++++++++++++++++++++++
1 file changed, 27 insertions(+)
diff --git a/tests/concurrent-web-server.scm b/tests/concurrent-web-server.scm
index b6c4016..e867fa4 100644
--- a/tests/concurrent-web-server.scm
+++ b/tests/concurrent-web-server.scm
@@ -68,10 +68,37 @@
(endianness little)
4)))))))
+(define (wait-for-port port)
+ "Wait until someone is listening on @var{port}."
+ (let ((sock (socket AF_INET SOCK_STREAM 0))
+ (address (make-socket-address AF_INET INADDR_LOOPBACK port)))
+ (let loop ((i 0))
+ (catch 'system-error
+ (lambda ()
+ (connect sock address)
+ (close-port sock)
+ #t)
+ (lambda args
+ (if (= (system-error-errno args) ECONNREFUSED)
+ (if (> i 30)
+ (begin
+ (format #t "web server didn't show up on port ~a; \
+bailing out~%"
+ port)
+ (exit 1))
+ (begin
+ (format #t "retrying connection on port ~s in 1s...~%"
+ port)
+ (sleep 1)
+ (loop (+ 1 i))))
+ (apply throw args)))))))
+
(call-with-new-thread
(lambda ()
(run-server handler #:port 8080)))
+(wait-for-port 8080)
+
(call-with-values
(lambda ()
(http-get (string->uri "http://127.0.0.1:8080/proc")
--
2.47.3
|
