mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

tests: Skip web server tests when thread support is missing.

Browse source 
* test-suite/tests/web-server.test ("server is listening"): Throw to
'unresolved when not (provided? 'threads).
This commit is contained in:
Ludovic Courtès 2023-07-16 21:47:44 +02:00
parent 85520354a8
commit aa44ad3fb8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 22 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

42
test-suite/tests/web-server.test
View file

@ -1,6 +1,6 @@
;;;; web-server.test --- HTTP server -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2019-2020, 2022 Free Software Foundation, Inc.
;;;; Copyright (C) 2019-2020, 2022, 2023 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -78,26 +78,28 @@
(pass-if "server is listening"
;; First, wait until the server is listening, up to a few seconds.
(let ((socket (socket AF_INET SOCK_STREAM 0)))
(let loop ((n 1))
(define success?
(catch 'system-error
(lambda ()
(format (current-error-port)
"connecting to the server, attempt #~a~%" n)
(connect socket AF_INET INADDR_LOOPBACK %port-number)
(close-port socket)
#t)
(lambda args
(if (and (= ECONNREFUSED (system-error-errno args))
(<= n 15))
#f
(apply throw args)))))
(if (provided? 'threads)
(let ((socket (socket AF_INET SOCK_STREAM 0)))
(let loop ((n 1))
(define success?
(catch 'system-error
(lambda ()
(format (current-error-port)
"connecting to the server, attempt #~a~%" n)
(connect socket AF_INET INADDR_LOOPBACK %port-number)
(close-port socket)
#t)
(lambda args
(if (and (= ECONNREFUSED (system-error-errno args))
(<= n 15))
#f
(apply throw args)))))
(or success?
(begin
(sleep 1)
(loop (+ n 1)))))))
(or success?
(begin
(sleep 1)
(loop (+ n 1))))))
(throw 'unresolved)))
(pass-if-equal "GET /"
"Hello, λ world!"