Subject: [bug#46216] [PATCH] Remove duplication in tests/publish.scm

From: Maxime Devos <[email-masked]>
Date: Sun, 31 Jan 2021 19:52:18 +0100

Oops, I forgot to attach the patch.
From de2a51437482c4a6aa812872f15804803650c128 Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
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(-)

diff --git a/tests/publish.scm b/tests/publish.scm
index 52101876b5..7c90332bda 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2015 David Thompson <[email-masked]>
 ;;; Copyright © 2020 by Amar M. Singh <[email-masked]>
 ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <[email-masked]>
+;;; Copyright © 2021 Maxime Devos <[email-masked]>
 ;;;
 ;;; 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