114 lines
2.5 KiB
Scheme
114 lines
2.5 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-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))))
|
|
|
|
(display "parallelism test finished successfully\n")
|