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; -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -78,26 +78,28 @@
(pass-if "server is listening" (pass-if "server is listening"
;; First, wait until the server is listening, up to a few seconds. ;; First, wait until the server is listening, up to a few seconds.
(let ((socket (socket AF_INET SOCK_STREAM 0))) (if (provided? 'threads)
(let loop ((n 1)) (let ((socket (socket AF_INET SOCK_STREAM 0)))
(define success? (let loop ((n 1))
(catch 'system-error (define success?
(lambda () (catch 'system-error
(format (current-error-port) (lambda ()
"connecting to the server, attempt #~a~%" n) (format (current-error-port)
(connect socket AF_INET INADDR_LOOPBACK %port-number) "connecting to the server, attempt #~a~%" n)
(close-port socket) (connect socket AF_INET INADDR_LOOPBACK %port-number)
#t) (close-port socket)
(lambda args #t)
(if (and (= ECONNREFUSED (system-error-errno args)) (lambda args
(<= n 15)) (if (and (= ECONNREFUSED (system-error-errno args))
#f (<= n 15))
(apply throw args))))) #f
(apply throw args)))))
(or success? (or success?
(begin (begin
(sleep 1) (sleep 1)
(loop (+ n 1))))))) (loop (+ n 1))))))
(throw 'unresolved)))
(pass-if-equal "GET /" (pass-if-equal "GET /"
"Hello, λ world!" "Hello, λ world!"