From de2a51437482c4a6aa812872f15804803650c128 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 31 Jan 2021 19:48:14 +0100
Subject: [PATCH] tests: publish: lessen code duplication.
* tests/publish.scm (spawn-guix-publish): introduce
procedure, and adjust tests to use it instead of
using an inline definition.
---
tests/publish.scm | 82 +++++++++++++++++++----------------------------
1 file changed, 33 insertions(+), 49 deletions(-)
@@ -2,6 +2,7 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -92,11 +93,20 @@
(lambda ()
exp ...)))))
-;; Run a local publishing server in a separate thread.
-(with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6789" "-C0")))) ;attempt to avoid port collision
+;; Run local publishing servers in a separate thread.
+;; Attempt to avoid port collision by choosing ports
+;; unlikely to be used in the wild (6789 and higher)
+(define (spawn-guix-publish port . extra-arguments)
+ "Run a local publishing server in a separate thread.
+The server will listen at PORT. EXTRA-ARGUMENTS are
+passed as-is as extra command-line arguments.
+The resulting thread is returned."
+ (with-separate-output-ports
+ (call-with-new-thread
+ (lambda ()
+ (apply guix-publish (format #f "--port=~a" port) extra-arguments)))))
+
+(spawn-guix-publish 6789 "-C0")
(define (wait-until-ready port)
;; Wait until the server is accepting connections.
@@ -257,10 +267,7 @@ References: ~%"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/gzip/" (basename %item)))
("Compression" . "gzip"))
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6799" "-C5"))))))
+ (let ((thread (spawn-guix-publish 6799 "-C5")))
(wait-until-ready 6799)
(let* ((url (string-append "http://localhost:6799/"
(store-path-hash-part %item) ".narinfo"))
@@ -277,10 +284,7 @@ References: ~%"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/lzip/" (basename %item)))
("Compression" . "lzip"))
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6790" "-Clzip"))))))
+ (let ((thread (spawn-guix-publish 6790 "-Clzip")))
(wait-until-ready 6790)
(let* ((url (string-append "http://localhost:6790/"
(store-path-hash-part %item) ".narinfo"))
@@ -315,10 +319,7 @@ References: ~%"
200)
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2"))))))
+ (let ((thread (spawn-guix-publish 6793 "-Cgzip:2" "-Clzip:2")))
(wait-until-ready 6793)
(let* ((base "http://localhost:6793/")
(part (store-path-hash-part %item))
@@ -339,11 +340,8 @@ References: ~%"
("Compression" . "none"))
200
404)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6798" "-C0"
- "--nar-path=///foo/bar//chbouib/"))))))
+ (let ((thread (spawn-guix-publish 6798 "-C0"
+ "--nar-path=///foo/bar//chbouib/")))
(wait-until-ready 6798)
(let* ((base "http://localhost:6798/")
(part (store-path-hash-part %item))
@@ -425,12 +423,9 @@ References: ~%"
404) ;nar/…
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6797" "-C2"
- (string-append "--cache=" cache)
- "--cache-bypass-threshold=0"))))))
+ (let ((thread (spawn-guix-publish 6797 "-C2"
+ (string-append "--cache=" cache)
+ "--cache-bypass-threshold=0")))
(wait-until-ready 6797)
(let* ((base "http://localhost:6797/")
(part (store-path-hash-part %item))
@@ -480,12 +475,9 @@ References: ~%"
'(200 200 404)
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2"
- (string-append "--cache=" cache)
- "--cache-bypass-threshold=0"))))))
+ (let ((thread (spawn-guix-publish 6794 "-Cgzip:2" "-Clzip:2"
+ (string-append "--cache=" cache)
+ "--cache-bypass-threshold=0")))
(wait-until-ready 6794)
(let* ((base "http://localhost:6794/")
(part (store-path-hash-part %item))
@@ -588,11 +580,8 @@ References: ~%"
200
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6795"
- (string-append "--cache=" cache)))))))
+ (let ((thread (spawn-guix-publish 6795
+ (string-append "--cache=" cache))))
(wait-until-ready 6795)
;; Make sure that, even if ITEM disappears, we're still able to fetch
@@ -615,11 +604,9 @@ References: ~%"
200
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6788" "-C" "gzip"
- (string-append "--cache=" cache)))))))
+ (let ((thread (spawn-guix-publish 6788 "-C" "gzip"
+ "--port=6788" "-C" "gzip"
+ (string-append "--cache=" cache))))
(wait-until-ready 6788)
(let* ((base "http://localhost:6788/")
@@ -651,11 +638,8 @@ References: ~%"
;; for a non-existing file name.
(call-with-temporary-directory
(lambda (cache)
- (let ((thread (with-separate-output-ports
- (call-with-new-thread
- (lambda ()
- (guix-publish "--port=6787" "-C" "gzip"
- (string-append "--cache=" cache)))))))
+ (let ((thread (spawn-guix-publish 6787 "-C" "gzip"
+ (string-append "--cache=" cache))))
(wait-until-ready 6787)
(let* ((base "http://localhost:6787/")
--
2.30.0