| Message ID | 87r18fdmtv.fsf_-_@gnu.org |
|---|---|
| State | New |
| Headers | show |
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.
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’.
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 --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: