~ruther/guix-local: tests: ‘rewrite-url’ test no longer depends on network access.

72fc91b113564f8006094c0118f06af0f414d21b — Ludovic Courtès 2 years ago bab1d17

tests: ‘rewrite-url’ test no longer depends on network access.

Fixes <https://issues.guix.gnu.org/66097>.
Previously, this test would actually need to access dist.libuv.org.

* tests/gnu-maintenance.scm ("rewrite-url, without to-version"): Change
URLs from https to http, and from libuv.org to libuv.example.org.
Parameterize ‘current-http-proxy’.

Reported-by: Janneke Nieuwenhuizen <janneke@gnu.org>

patch browse .tar.gz .zip

1 files changed, 7 insertions(+), 5 deletions(-)

M tests/gnu-maintenance.scm

M tests/gnu-maintenance.scm => tests/gnu-maintenance.scm +7 -5

@@ 25,6 25,7 @@
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
+  #:use-module ((web client) #:select (current-http-proxy))
   #:use-module (ice-9 match))
 
 (test-begin "gnu-maintenance")


@@ 157,9 158,9 @@ submodules/qtbase-everywhere-src-6.5.2.tar.xz"
 submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
 
 (test-equal "rewrite-url, without to-version"
-  "https://dist.libuv.org/dist/v1.46.0/libuv-v1.46.0.tar.gz"
+  "http://dist.libuv.example.org/dist/v1.46.0/libuv-v1.46.0.tar.gz"
   (with-http-server
-      ;; First reply, crawling https://dist.libuv.org/dist/.
+      ;; First reply, crawling http://dist.libuv.example.org/dist/.
       `((200 "\
 <!DOCTYPE html>
 <html>


@@ 173,7 174,7 @@ submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
 <a href=\"v1.46.0/\" title=\"v1.46.0/\">v1.46.0/</a>
 </body>
 </html>")
-        ;; Second reply, crawling https://dist.libuv.org/dist/v1.46.0/.
+        ;; Second reply, crawling http://dist.libuv.example.org/dist/v1.46.0/.
         (200 "\
 <!DOCTYPE html>
 <html>


@@ 190,7 191,8 @@ submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
    libuv-v1.46.0.tar.gz.sign</a>
 </body>
 </html>"))
-    (rewrite-url "https://dist.libuv.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
-                 "1.45.0")))
+    (parameterize ((current-http-proxy (%local-url)))
+      (rewrite-url "http://dist.libuv.example.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
+                   "1.45.0"))))
 
 (test-end)