diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-08-02 17:48:21 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-08-02 18:07:19 +0200 |
commit | a5c376034f0c465c00e88283dae6d59ac49612a9 (patch) | |
tree | bc0d6e57cad14a39bc4c220d375ab475e0140a4f | |
parent | 2c7b48c2fbccc0b2fc09ae055ce5b32f3fe6b441 (diff) | |
download | guix-a5c376034f0c465c00e88283dae6d59ac49612a9.tar.gz |
tests: Make sure threads use separate output ports.
* tests/publish.scm (with-separate-output-ports): New macro. <top level>: Use it when spawning new thread. ("/*.narinfo with compression"): Likewise.
-rw-r--r-- | tests/publish.scm | 24 |
1 files changed, 18 insertions, 6 deletions
diff --git a/tests/publish.scm b/tests/publish.scm index 99d341da46..0fd3b50ecb 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -73,10 +73,21 @@ (define (publish-uri route) (string-append "http://localhost:6789" route)) +(define-syntax-rule (with-separate-output-ports exp ...) + ;; Since ports aren't thread-safe in Guile 2.0, duplicate the output and + ;; error ports to make sure the two threads don't end up stepping on each + ;; other's toes. + (with-output-to-port (duplicate-port (current-output-port) "w") + (lambda () + (with-error-to-port (duplicate-port (current-error-port) "w") + (lambda () + exp ...))))) + ;; Run a local publishing server in a separate thread. -(call-with-new-thread - (lambda () - (guix-publish "--port=6789" "-C0"))) ;attempt to avoid port collision +(with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6789" "-C0")))) ;attempt to avoid port collision (define (wait-until-ready port) ;; Wait until the server is accepting connections. @@ -186,9 +197,10 @@ References: ~%" `(("StorePath" . ,%item) ("URL" . ,(string-append "nar/gzip/" (basename %item))) ("Compression" . "gzip")) - (let ((thread (call-with-new-thread - (lambda () - (guix-publish "--port=6799" "-C5"))))) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6799" "-C5")))))) (wait-until-ready 6799) (let* ((url (string-append "http://localhost:6799/" (store-path-hash-part %item) ".narinfo")) |