From 4e33da98aa421d80dfd3e0e4cb29863c6f087fd4 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 8 Mar 2025 09:39:27 +0000
Subject: [PATCH] Fix some exception handling issues

---
 knots/parallelism.scm |  7 +++++--
 tests/parallelism.scm | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 38 insertions(+), 2 deletions(-)

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")