guile-knots/tests/parallelism.scm
Christopher Baines 8f3e0a9a1d
All checks were successful
/ test (push) Successful in 9s
Fix exception handling in fibers-map-with-progress
2025-06-26 22:53:15 +02:00

144 lines
3.3 KiB
Scheme

(use-modules (tests)
(fibers)
(unit-test)
(ice-9 exceptions)
(knots parallelism))
;; Test fibers-map
(run-fibers-for-tests
(lambda ()
(assert-equal
1122
(apply + (fibers-map
(lambda (i)
(* 2 i))
(iota 34))))))
;; Test fibers-batch-map with a large batch size
(run-fibers-for-tests
(lambda ()
(assert-equal
1122
(apply + (fibers-batch-map
(lambda (i)
(* 2 i))
100
(iota 34))))))
;; Test fibers-map with an empty list
(run-fibers-for-tests
(lambda ()
(fibers-map identity '())))
;; Test fibers-map with an empty vector
(run-fibers-for-tests
(lambda ()
(fibers-map identity #())))
;; Test fibers-map with vectors
(run-fibers-for-tests
(lambda ()
(assert-equal
1122
(apply + (vector->list
(fibers-map
(lambda (i)
(* 2 i))
(list->vector (iota 34))))))))
;; Test fibers-for-each
(run-fibers-for-tests
(lambda ()
(fibers-for-each
(lambda (i)
(* 2 i))
(iota 34))))
;; Test fibers-map-with-progress with an empty list
(run-fibers-for-tests
(lambda ()
(fibers-map-with-progress
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
(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)))
(run-fibers-for-tests
(lambda ()
(let ((a 0))
(call-with-values
(lambda ()
(fibers-parallel
(begin
(sleep 1)
1)
(begin
(set! a 1)
2)))
(lambda (a b)
(assert-equal a 1)
(assert-equal b 2)))
(assert-equal a 1))))
(run-fibers-for-tests
(lambda ()
(let ((parallelism-limiter (make-parallelism-limiter 2)))
(fibers-for-each
(lambda _
(with-parallelism-limiter
parallelism-limiter
#f))
(iota 50))
(destroy-parallelism-limiter parallelism-limiter))))
(display "parallelism test finished successfully\n")