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

From: Maxime Devos <[email-masked]>
Date: Sun, 31 Jan 2021 23:10:57 +0100

I accidentally sent this to guix-patches instead of
[email-masked].

-------- Forwarded Message --------
From: Maxime Devos <[email-masked]>
Reply-To: [email-masked]
To: [email-masked]
Subject: Re: [PATCH] Remove duplication in tests/publish.scm
Date: Sun, 31 Jan 2021 23:01:48 +0100

This is the third patch in the series.  Description
from patch:

  This way, there's no risk of accidentally reusing a
  port number used by another test.  This changes the
  workings of the "/*.narinfo for a compressed file" test
  a little, by not reusing the port from the test
  "/*.narinfo with compression".

  * tests/publish.scm
    (*latest-port*, call-with-guix-publish, with-guix-publish):
    automatically assign port numbers, and change tests to
    use the new calling rules.

From 3548be9cb7b862b04defad080a80c85311475c06 Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Sun, 31 Jan 2021 22:53:04 +0100
Subject: [PATCH 3/3] tests: publish: automatically keep track of port numbers

This way, there's no risk of accidentally reusing a
port number used by another test.  This changes the
workings of the "/*.narinfo for a compressed file" test
a little, by not reusing the port from the test
"/*.narinfo with compression".

* tests/publish.scm
  (*latest-port*, call-with-guix-publish, with-guix-publish):
  automatically assign port numbers, and change tests to
  use the new calling rules.
---
 tests/publish.scm | 84 +++++++++++++++++++++++++----------------------
 1 file changed, 45 insertions(+), 39 deletions(-)

diff --git a/tests/publish.scm b/tests/publish.scm
index e24b0feb00..0a132dfe04 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -106,17 +106,23 @@ 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)))
+;; Keep track of port numbers, to avoid multiple
+;; servers listening at the same port.
+(define *latest-port* 6789)
+
+(define (call-with-guix-publish extra-arguments proc)
+  "Call PROC in an environment where a local publishing service
+is running in a separate thread, passing the port listened at.
+EXTRA-ARGUMENTS are passed as-is as extra command-line arguments."
+  (let* ((port (1+ *latest-port*))
+         (thread (apply spawn-guix-publish port extra-arguments)))
+    (set! *latest-port* port)
     (wait-until-ready port)
-    (thunk)))
+    (proc port)))
 
 (define-syntax-rule (with-guix-publish port extra-arguments exp ...)
-  (call-with-guix-publish port extra-arguments
-    (lambda () exp ...)))
+  (call-with-guix-publish extra-arguments
+    (lambda (port) exp ...)))
 
 (spawn-guix-publish 6789 "-C0")
 
@@ -279,9 +285,9 @@ References: ~%"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/gzip/" (basename %item)))
     ("Compression" . "gzip"))
-  (with-guix-publish 6799 '("-C5")
-    (let* ((url  (string-append "http://localhost:6799/"
-                                (store-path-hash-part %item) ".narinfo"))
+  (with-guix-publish port '("-C5")
+    (let* ((url  (format #f "http://localhost:~a/~a.narinfo" port
+                         (store-path-hash-part %item)))
            (body (http-get-port url)))
       (filter (lambda (item)
                 (match item
@@ -295,9 +301,9 @@ References: ~%"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/lzip/" (basename %item)))
     ("Compression" . "lzip"))
-  (with-guix-publish 6790 '("-Clzip")
-    (let* ((url  (string-append "http://localhost:6790/"
-                                (store-path-hash-part %item) ".narinfo"))
+  (with-guix-publish port '("-Clzip")
+    (let* ((url  (format #f "http://localhost:~a/~a.narinfo" port
+                         (store-path-hash-part %item)))
            (body (http-get-port url)))
       (filter (lambda (item)
                 (match item
@@ -309,15 +315,15 @@ References: ~%"
 
 (test-equal "/*.narinfo for a compressed file"
   '("none" "nar")          ;compression-less nar
-  ;; Assume 'guix publish -C' is already running on port 6799.
-  (let* ((item (add-text-to-store %store "fake.tar.gz"
-                                  "This is a fake compressed file."))
-         (url  (string-append "http://localhost:6799/"
-                              (store-path-hash-part item) ".narinfo"))
-         (body (http-get-port url))
-         (info (recutils->alist body)))
-    (list (assoc-ref info "Compression")
-          (dirname (assoc-ref info "URL")))))
+  (with-guix-publish port '("-C5")
+    (let* ((item (add-text-to-store %store "fake.tar.gz"
+                                    "This is a fake compressed file."))
+           (url  (format #f "http://localhost:~a/~a.narinfo" port
+                         (store-path-hash-part item)))
+           (body (http-get-port url))
+           (info (recutils->alist body)))
+      (list (assoc-ref info "Compression")
+            (dirname (assoc-ref info "URL"))))))
 
 (test-equal "/*.narinfo with lzip + gzip"
   `((("StorePath" . ,%item)
@@ -329,8 +335,8 @@ References: ~%"
     200)
   (call-with-temporary-directory
    (lambda (cache)
-     (with-guix-publish 6793 '("-Cgzip:2" "-Clzip:2")
-       (let* ((base "http://localhost:6793/")
+     (with-guix-publish port '("-Cgzip:2" "-Clzip:2")
+       (let* ((base (format #f "http://localhost:~a/" port))
               (part (store-path-hash-part %item))
               (url  (string-append base part ".narinfo"))
               (body (http-get-port url)))
@@ -349,8 +355,8 @@ References: ~%"
           ("Compression" . "none"))
         200
         404)
-  (with-guix-publish 6798 '("-C0" "--nar-path=///foo/bar//chbouib/")
-    (let* ((base    "http://localhost:6798/")
+  (with-guix-publish port '("-C0" "--nar-path=///foo/bar//chbouib/")
+    (let* ((base    (format #f "http://localhost:~a/" port))
            (part    (store-path-hash-part %item))
            (url     (string-append base part ".narinfo"))
            (nar-url (string-append base "foo/bar/chbouib/"
@@ -430,9 +436,9 @@ References: ~%"
         404)                                      ;nar/…
   (call-with-temporary-directory
    (lambda (cache)
-     (with-guix-publish 6797 `("-C2" ,(string-append "--cache=" cache)
+     (with-guix-publish port `("-C2" ,(string-append "--cache=" cache)
                                "--cache-bypass-threshold=0")
-       (let* ((base     "http://localhost:6797/")
+       (let* ((base     (format #f "http://localhost:~a/" port))
               (part     (store-path-hash-part %item))
               (url      (string-append base part ".narinfo"))
               (nar-url  (string-append base "nar/gzip/" (basename %item)))
@@ -480,10 +486,10 @@ References: ~%"
   '(200 200 404)
   (call-with-temporary-directory
    (lambda (cache)
-     (with-guix-publish 6794 `("-Cgzip:2" "-Clzip:2"
+     (with-guix-publish port `("-Cgzip:2" "-Clzip:2"
                                ,(string-append "--cache=" cache)
                                "--cache-bypass-threshold=0")
-       (let* ((base     "http://localhost:6794/")
+       (let* ((base     (format #f "http://localhost:~a/" port))
               (part     (store-path-hash-part %item))
               (url      (string-append base part ".narinfo"))
               (nar-url  (cute string-append "nar/" <> "/"
@@ -532,10 +538,10 @@ References: ~%"
           404)                                    ;nar/gzip/…
     (call-with-temporary-directory
      (lambda (cache)
-       (with-guix-publish 6796 `("-C2" "--ttl=42h"
+       (with-guix-publish port `("-C2" "--ttl=42h"
                                  ,(string-append "--cache=" cache)
                                  "--cache-bypass-threshold=0")
-         (let* ((base     "http://localhost:6796/")
+         (let* ((base     (format #f "http://localhost:~a/" port))
                 (part     (store-path-hash-part item))
                 (url      (string-append base part ".narinfo"))
                 (cached   (string-append cache "/none/"
@@ -580,11 +586,11 @@ References: ~%"
   200
   (call-with-temporary-directory
    (lambda (cache)
-     (with-guix-publish 6795 (list (string-append "--cache=" cache))
+     (with-guix-publish port (list (string-append "--cache=" cache))
 
        ;; Make sure that, even if ITEM disappears, we're still able to fetch
        ;; it.
-       (let* ((base     "http://localhost:6795/")
+       (let* ((base     (format #f "http://localhost:~a/" port))
               (item     (add-text-to-store %store "random" (random-text)))
               (part     (store-path-hash-part item))
               (url      (string-append base part ".narinfo"))
@@ -602,9 +608,9 @@ References: ~%"
   200
   (call-with-temporary-directory
    (lambda (cache)
-     (with-guix-publish 6788 `("-C" "gzip" "-C" "gzip"
+     (with-guix-publish port `("-C" "gzip" "-C" "gzip"
                                ,(string-append "--cache=" cache))
-       (let* ((base     "http://localhost:6788/")
+       (let* ((base     (format #f "http://localhost:~a/" port))
               (item     (add-text-to-store %store "random" (random-text)))
               (part     (store-path-hash-part item))
               (narinfo  (string-append base part ".narinfo"))
@@ -633,9 +639,9 @@ References: ~%"
   ;; for a non-existing file name.
   (call-with-temporary-directory
    (lambda (cache)
-     (with-guix-publish 6787 `("-C" "gzip" ,(string-append "--cache=" cache))
+     (with-guix-publish port `("-C" "gzip" ,(string-append "--cache=" cache))
 
-       (let* ((base     "http://localhost:6787/")
+       (let* ((base     (format #f "http://localhost:~a/" port))
               (item     (add-text-to-store %store "random" (random-text)))
               (part     (store-path-hash-part item))
               (narinfo  (string-append base part ".narinfo"))
-- 
2.30.0