Fix exception handling in fibers-map-with-progress
All checks were successful
/ test (push) Successful in 9s

This commit is contained in:
Christopher Baines 2025-06-26 22:53:15 +02:00
parent 09ca6cfb6b
commit 8f3e0a9a1d
2 changed files with 22 additions and 4 deletions

View file

@ -217,9 +217,9 @@
(if (null? active-channels)
(map
(match-lambda
((#f . ('exception . exn))
((#f . ('exception exn))
(raise-exception exn))
((#f . ('result . val))
((#f . ('result val))
val))
channels-to-results)
(loop
@ -239,10 +239,10 @@
(if (eq? channel c)
(cons #f
(match result
(('exception . exn)
(('exception exn)
result)
(_
(cons 'result result))))
(list 'result result))))
(cons c r))))
channels-to-results)))
#f))))

View file

@ -61,6 +61,24 @@
identity
'(()))))
(run-fibers-for-tests
(lambda ()
(with-exception-handler
(lambda (exn)
(unless (and (exception-with-message? exn)
(string=? (exception-message exn)
"foo"))
(raise-exception exn)))
(lambda ()
(fibers-map-with-progress
(lambda _
(raise-exception
(make-exception-with-message "foo")))
'((1)))
(error 'should-not-reach-here))
#:unwind? #t)))
(run-fibers-for-tests
(lambda ()
(with-exception-handler