diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-01-13 11:08:23 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-01-13 11:09:05 +0100 |
| commit | 4655005e2441c7001a89293242719fe35b894e40 (patch) | |
| tree | 3e3da64201bff536d5c5678f644c3d6882d4165a /tests/lint.scm | |
| parent | 35ed9306b980591f108e01c87a811b63df011fbf (diff) | |
| download | patches-4655005e2441c7001a89293242719fe35b894e40.tar patches-4655005e2441c7001a89293242719fe35b894e40.tar.gz | |
tests: Properly synchronize threads in the 'home-page' lint tests.
* tests/lint.scm (%http-server-lock, %http-server-ready): New
variables.
(http-open): New procedure.
(stub-http-server): Use it.
(call-with-http-server): Wrap body in 'with-mutex'. Call
'wait-condition-variable' after 'make-thread'.
Diffstat (limited to 'tests/lint.scm')
| -rw-r--r-- | tests/lint.scm | 23 |
1 files changed, 18 insertions, 5 deletions
diff --git a/tests/lint.scm b/tests/lint.scm index c6931329d6..27be5598de 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -75,9 +75,20 @@ (quit #t) ;exit the server thread (values))) +;; Mutex and condition variable to synchronize with the HTTP server. +(define %http-server-lock (make-mutex)) +(define %http-server-ready (make-condition-variable)) + +(define (http-open . args) + "Start listening for HTTP requests and signal %HTTP-SERVER-READY." + (with-mutex %http-server-lock + (let ((result (apply (@@ (web server http) http-open) args))) + (signal-condition-variable %http-server-ready) + result))) + (define-server-impl stub-http-server ;; Stripped-down version of Guile's built-in HTTP server. - (@@ (web server http) http-open) + http-open (@@ (web server http) http-read) http-write (@@ (web server http) http-close)) @@ -97,9 +108,11 @@ requests." `(#:socket ,%http-server-socket))) (const #t))) - (let* ((server (make-thread server-body))) - ;; Normally SERVER exits automatically once it has received a request. - (thunk))) + (with-mutex %http-server-lock + (let ((server (make-thread server-body))) + (wait-condition-variable %http-server-ready %http-server-lock) + ;; Normally SERVER exits automatically once it has received a request. + (thunk)))) (define-syntax-rule (with-http-server code body ...) (call-with-http-server code (lambda () body ...))) |