Fix some exception handling issues

This commit is contained in:
Christopher Baines 2025-03-08 09:39:27 +00:00
parent 3aab1be1e7
commit 4e33da98aa
2 changed files with 38 additions and 2 deletions

View file

@ -72,7 +72,7 @@
reply-channels))) reply-channels)))
(map (map
(match-lambda (match-lambda
(('exception exn stack) (('exception exn)
(raise-exception exn)) (raise-exception exn))
(result (result
(apply values result))) (apply values result)))
@ -254,7 +254,10 @@
(let ((stack (make-stack #t (let ((stack (make-stack #t
0 prompt-tag 0 prompt-tag
0 (and prompt-tag 1)))) 0 (and prompt-tag 1))))
(return (list 'exception exn stack)))))) (return (list 'exception
(make-exception
exn
(make-knots-exception stack))))))))
(lambda () (lambda ()
(call-with-values (call-with-values
(lambda () (lambda ()

View file

@ -1,6 +1,7 @@
(use-modules (tests) (use-modules (tests)
(fibers) (fibers)
(unit-test) (unit-test)
(ice-9 exceptions)
(knots parallelism)) (knots parallelism))
;; Test fibers-map ;; Test fibers-map
@ -60,4 +61,36 @@
identity 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-for-each
(lambda (i)
(raise-exception
(make-exception-with-message "foo")))
(iota 2)))
#:unwind? #t)))
(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 ()
((fiberize
(lambda (i)
(raise-exception
(make-exception-with-message "foo"))))
1))
#:unwind? #t)))
(display "parallelism test finished successfully\n") (display "parallelism test finished successfully\n")