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

[Maxime Devos <maximedevos@telenet.be>]

[-- Attachment #1.1: Type: text/plain, Size: 264 bytes --]

This is the second patch in the series.  Description
from commit message:

* tests/publish.scm
  (call-with-guix-publish, with-guix-publish): introduce
  combination of spawn-guix-publish and wait-until-ready,
  and adjust tests to use the macro.

Maxime

[-- Attachment #1.2: 0002-tests-publish-remove-duplicated-use-of-wait-until-re.patch --]
[-- Type: text/x-patch, Size: 7299 bytes --]

From dc166f96da951ed045ddc87441428a44693035cd Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 31 Jan 2021 20:58:46 +0100
Subject: [PATCH] tests: publish: remove duplicated use of wait-until-ready

* tests/publish.scm
  (call-with-guix-publish, with-guix-publish): introduce
  combination of spawn-guix-publish and wait-until-ready,
  and adjust tests to use the macro.
---
 tests/publish.scm | 68 +++++++++++++++++++++++------------------------
 1 file changed, 33 insertions(+), 35 deletions(-)

diff --git a/tests/publish.scm b/tests/publish.scm
index 7c90332bda..e24b0feb00 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -106,6 +106,18 @@ The resulting thread is returned."
     (lambda ()
       (apply guix-publish (format #f "--port=~a" port) extra-arguments)))))
 
+(define (call-with-guix-publish port extra-arguments thunk)
+  "Call THUNK in an environment where a local publishing service
+is running in a separate thread, listening at PORT.  EXTRA-ARGUMENTS
+are passed as-is as extra command-line arguments."
+  (let ((thread (apply spawn-guix-publish port extra-arguments)))
+    (wait-until-ready port)
+    (thunk)))
+
+(define-syntax-rule (with-guix-publish port extra-arguments exp ...)
+  (call-with-guix-publish port extra-arguments
+    (lambda () exp ...)))
+
 (spawn-guix-publish 6789 "-C0")
 
 (define (wait-until-ready port)
@@ -267,8 +279,7 @@ References: ~%"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/gzip/" (basename %item)))
     ("Compression" . "gzip"))
-  (let ((thread (spawn-guix-publish 6799 "-C5")))
-    (wait-until-ready 6799)
+  (with-guix-publish 6799 '("-C5")
     (let* ((url  (string-append "http://localhost:6799/"
                                 (store-path-hash-part %item) ".narinfo"))
            (body (http-get-port url)))
@@ -284,8 +295,7 @@ References: ~%"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/lzip/" (basename %item)))
     ("Compression" . "lzip"))
-  (let ((thread (spawn-guix-publish 6790 "-Clzip")))
-    (wait-until-ready 6790)
+  (with-guix-publish 6790 '("-Clzip")
     (let* ((url  (string-append "http://localhost:6790/"
                                 (store-path-hash-part %item) ".narinfo"))
            (body (http-get-port url)))
@@ -319,8 +329,7 @@ References: ~%"
     200)
   (call-with-temporary-directory
    (lambda (cache)
-     (let ((thread (spawn-guix-publish 6793 "-Cgzip:2" "-Clzip:2")))
-       (wait-until-ready 6793)
+     (with-guix-publish 6793 '("-Cgzip:2" "-Clzip:2")
        (let* ((base "http://localhost:6793/")
               (part (store-path-hash-part %item))
               (url  (string-append base part ".narinfo"))
@@ -340,9 +349,7 @@ References: ~%"
           ("Compression" . "none"))
         200
         404)
-  (let ((thread (spawn-guix-publish 6798 "-C0"
-                                    "--nar-path=///foo/bar//chbouib/")))
-    (wait-until-ready 6798)
+  (with-guix-publish 6798 '("-C0" "--nar-path=///foo/bar//chbouib/")
     (let* ((base    "http://localhost:6798/")
            (part    (store-path-hash-part %item))
            (url     (string-append base part ".narinfo"))
@@ -423,10 +430,8 @@ References: ~%"
         404)                                      ;nar/…
   (call-with-temporary-directory
    (lambda (cache)
-     (let ((thread (spawn-guix-publish 6797 "-C2"
-                                       (string-append "--cache=" cache)
-                                       "--cache-bypass-threshold=0")))
-       (wait-until-ready 6797)
+     (with-guix-publish 6797 `("-C2" ,(string-append "--cache=" cache)
+                               "--cache-bypass-threshold=0")
        (let* ((base     "http://localhost:6797/")
               (part     (store-path-hash-part %item))
               (url      (string-append base part ".narinfo"))
@@ -475,10 +480,9 @@ References: ~%"
   '(200 200 404)
   (call-with-temporary-directory
    (lambda (cache)
-     (let ((thread (spawn-guix-publish 6794 "-Cgzip:2" "-Clzip:2"
-                                       (string-append "--cache=" cache)
-                                       "--cache-bypass-threshold=0")))
-       (wait-until-ready 6794)
+     (with-guix-publish 6794 `("-Cgzip:2" "-Clzip:2"
+                               ,(string-append "--cache=" cache)
+                               "--cache-bypass-threshold=0")
        (let* ((base     "http://localhost:6794/")
               (part     (store-path-hash-part %item))
               (url      (string-append base part ".narinfo"))
@@ -528,13 +532,9 @@ References: ~%"
           404)                                    ;nar/gzip/…
     (call-with-temporary-directory
      (lambda (cache)
-       (let ((thread (with-separate-output-ports
-                      (call-with-new-thread
-                       (lambda ()
-                         (guix-publish "--port=6796" "-C2" "--ttl=42h"
-                                       (string-append "--cache=" cache)
-                                       "--cache-bypass-threshold=0"))))))
-         (wait-until-ready 6796)
+       (with-guix-publish 6796 `("-C2" "--ttl=42h"
+                                 ,(string-append "--cache=" cache)
+                                 "--cache-bypass-threshold=0")
          (let* ((base     "http://localhost:6796/")
                 (part     (store-path-hash-part item))
                 (url      (string-append base part ".narinfo"))
@@ -580,9 +580,7 @@ References: ~%"
   200
   (call-with-temporary-directory
    (lambda (cache)
-     (let ((thread (spawn-guix-publish 6795
-                                       (string-append "--cache=" cache))))
-       (wait-until-ready 6795)
+     (with-guix-publish 6795 (list (string-append "--cache=" cache))
 
        ;; Make sure that, even if ITEM disappears, we're still able to fetch
        ;; it.
@@ -604,11 +602,8 @@ References: ~%"
   200
   (call-with-temporary-directory
    (lambda (cache)
-     (let ((thread (spawn-guix-publish 6788 "-C" "gzip"
-                                       "--port=6788" "-C" "gzip"
-                                       (string-append "--cache=" cache))))
-       (wait-until-ready 6788)
-
+     (with-guix-publish 6788 `("-C" "gzip" "-C" "gzip"
+                               ,(string-append "--cache=" cache))
        (let* ((base     "http://localhost:6788/")
               (item     (add-text-to-store %store "random" (random-text)))
               (part     (store-path-hash-part item))
@@ -638,9 +633,7 @@ References: ~%"
   ;; for a non-existing file name.
   (call-with-temporary-directory
    (lambda (cache)
-     (let ((thread (spawn-guix-publish 6787 "-C" "gzip"
-                                       (string-append "--cache=" cache))))
-       (wait-until-ready 6787)
+     (with-guix-publish 6787 `("-C" "gzip" ,(string-append "--cache=" cache))
 
        (let* ((base     "http://localhost:6787/")
               (item     (add-text-to-store %store "random" (random-text)))
@@ -702,3 +695,8 @@ References: ~%"
                (http-post (publish-uri path))))))
 
 (test-end "publish")
+
+;; Local Variables:
+;; eval: (put 'with-guix-publish 'scheme-indent-function 2)
+;; eval: (put 'call-with-guix-publish 'scheme-indent-function 2)
+;; End:
-- 
2.30.0


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]