diff --git a/knots/parallelism.scm b/knots/parallelism.scm index f9be4ff..77272dd 100644 --- a/knots/parallelism.scm +++ b/knots/parallelism.scm @@ -72,7 +72,7 @@ reply-channels))) (map (match-lambda - (('exception exn stack) + (('exception exn) (raise-exception exn)) (result (apply values result))) @@ -254,7 +254,10 @@ (let ((stack (make-stack #t 0 prompt-tag 0 (and prompt-tag 1)))) - (return (list 'exception exn stack)))))) + (return (list 'exception + (make-exception + exn + (make-knots-exception stack)))))))) (lambda () (call-with-values (lambda () diff --git a/tests/parallelism.scm b/tests/parallelism.scm index 7d8dea7..f005d71 100644 --- a/tests/parallelism.scm +++ b/tests/parallelism.scm @@ -1,6 +1,7 @@ (use-modules (tests) (fibers) (unit-test) + (ice-9 exceptions) (knots parallelism)) ;; Test fibers-map @@ -60,4 +61,36 @@ 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")