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

Previous Next

Full log

View this message in rfc822 format

From: Ludovic Courtès <ludo <at> gnu.org>
To: Maxime Devos <maximedevos <at> telenet.be>
Cc: 53389 <at> debbugs.gnu.org
Subject: [bug#53389] [PATCH 0/9] Replace some mocking with with-http-server*, avoid hardcoding ports,
Date: Mon, 07 Feb 2022 10:53:48 +0100

[Message part 1 (text/plain, inline)]

Hi,

Maxime Devos <maximedevos <at> 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:

[Message part 2 (text/x-patch, inline)]

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 <at> gnu.org>
+;;; Copyright © 2015, 2017, 2019, 2020, 2022 Ludovic Courtès <ludo <at> 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:

[Message part 3 (text/plain, inline)]

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

WDYT?

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.