[bug#53389] [PATCH 0/9] Replace some mocking with with-http-server*, avoid hardcoding ports,

[Ludovic Courtès]

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

> Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
>> > +        (unless keep-lingering?
>> > +          ;; exit the server thread
>> > +          (system-async-mark (lambda () (throw 'quit)) server))
>> 
>> When do we need ‘keep-lingering?’?
>
> In tests/challenge.scm (call-mismatch-test), due to how the store monad
> work, the thunk technically returns (*) before we are done with the
> querying the server.  Perhaps this can be resolved with sufficient
> monadology, but I don't quite see how.
>
> (*) a monadic value.

How about fixing it locally like this:

diff --git a/tests/challenge.scm b/tests/challenge.scm
index fdd5fd238e..0b44ed7d21 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,6 +57,17 @@ (define-syntax with-derivation-narinfo*
        (lambda () body ...)
        hash))))
 
+(define-syntax-rule (with-http-server* arguments body ...)
+  ;; Like 'with-http-server' but for use in a monadic context.
+  (let ((port (%http-server-port)))
+    (lambda (store)
+      (values (parameterize ((%http-server-port port))
+                (call-with-http-server arguments
+                                       (lambda ()
+                                         (run-with-store store
+                                           body ...))))
+              store))))
+

 (test-begin "challenge")
 
@@ -198,11 +209,11 @@ (define (call-mismatch-test proc)
                                      (lambda (port)
                                        (write-file out2 port)))))
         (parameterize ((%http-server-port 9000))
-          (with-http-server `((200 ,(make-narinfo item size1 hash1))
-                              (200 ,nar1))
+          (with-http-server* `((200 ,(make-narinfo item size1 hash1))
+                               (200 ,nar1))
             (parameterize ((%http-server-port 9001))
-              (with-http-server `((200 ,(make-narinfo item size2 hash2))
-                                  (200 ,nar2))
+              (with-http-server* `((200 ,(make-narinfo item size2 hash2))
+                                   (200 ,nar2))
                 (mlet* %store-monad ((urls -> (list (%local-url 9000)
                                                     (%local-url 9001)))
                                      (reports (compare-contents (list item)
@@ -238,4 +249,5 @@ (define (call-mismatch-test proc)
 
 ;;; Local Variables:
 ;;; eval: (put 'with-derivation-narinfo* 'scheme-indent-function 2)
+;;; eval: (put 'with-http-server* 'scheme-indent-function 1)
 ;;; End:

That way we don’t need to keep the lingering variant in (guix tests
http).

WDYT?

Ludo’.