diff mbox

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

Message ID 87r18fdmtv.fsf_-_@gnu.org
State New
Headers show

Commit Message

Ludovic Courtès Feb. 7, 2022, 9:53 a.m. UTC
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:
That way we don’t need to keep the lingering variant in (guix tests
http).

WDYT?

Ludo’.

Comments

M Feb. 7, 2022, 10:59 a.m. UTC | #1
Ludovic Courtès schreef op ma 07-02-2022 om 10:53 [+0100]:
> 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:
> 
> That way we don’t need to keep the lingering variant in (guix tests
> http).
>
> WDYT?

Looks nice, though it isn't ideal that port 9000/9001 is hardcoded
here.  That can be left as an exercise for later though.  I'll do this
in the v2 (and remove keep-lingering?) whenever I get around to writing
the v2 (I'm mostly doing Scheme-GNUnet stuff at the moment).

Greetings,
Maaxime.
Ludovic Courtès March 6, 2022, 4:23 p.m. UTC | #2
Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> Looks nice, though it isn't ideal that port 9000/9001 is hardcoded
> here.  That can be left as an exercise for later though.  I'll do this
> in the v2 (and remove keep-lingering?) whenever I get around to writing
> the v2 (I'm mostly doing Scheme-GNUnet stuff at the moment).

I just remembered about this patch series.  Let me know when you can
come up with v2.

Ludo’.
M March 7, 2022, 7 a.m. UTC | #3
Ludovic Courtès schreef op zo 06-03-2022 om 17:23 [+0100]:
> I just remembered about this patch series.  Let me know when you can
> come up with v2.

Not right now, but there's another (older) patch series that should be
ready: <https://issues.guix.gnu.org/50299#91>.

Greetings,
Maxime.
diff mbox

Patch

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: