Fix exception handling in fibers-map-with-progress

knots/parallelism.scm

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

tests/parallelism.scm

@@ -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