test/dispatch.sgl

1(import (sigil async) (sigil channels) (sigil wm dispatch))

3(define owner (make-dispatcher))

4(define active 0)

5(define completed 0)

6(define failed 0)

7(define cancelled-call? #f)

8(define cancelled-ran? #f)

9(define replies (make-channel 20))

10(define (report exception) (raise exception))

11(define (owned-work id)

12 (set! active (+ active 1))

13 (unless (= active 1) (error "policy owner reentered" id))

14 (sleep 0.005)

15 (unless (= active 1) (error "policy owner changed across await" id))

16 (set! active (- active 1))

17 (set! completed (+ completed 1))

18 id)

20(with-async

21 (go

22 (let loop ()

23 (dispatcher-wait! owner)

24 (dispatcher-drain! owner)

25 (unless (dispatcher-closed? owner) (loop))))

26 (for-each

27 (lambda (id)

28 (go

29 (let ((result (dispatcher-call! owner (lambda () (owned-work id)))))

30 (unless (= result id) (error "policy reply was misrouted"))

31 (channel-send replies result))))

32 (iota 20))

33 (go

34 (let loop ((remaining 20))

35 (unless (= remaining 0)

36 (channel-receive replies)

37 (loop (- remaining 1))))

38 (dispatcher-enqueue! owner

39 (lambda (ignored)

40 (dispatcher-enqueue! owner (lambda (ignored) (error "cancelled job ran")) #f

41 report on-cancel: (lambda (exception) (set! failed (+ failed 1))))

42 (sleep 0.01)

43 (dispatcher-close! owner))

44 #f report)

45 (go

46 (guard (exception (#t (set! cancelled-call? #t)))

47 (dispatcher-call! owner (lambda () (set! cancelled-ran? #t) (error "cancelled call ran")))))))

48(unless (and (= completed 20) (= active 0) (= failed 1) cancelled-call?

49 (not cancelled-ran?) (dispatcher-closed? owner))

50 (error "policy dispatch completion/cancellation failed" completed active failed))

51(unless (not (dispatcher-enqueue! owner (lambda (ignored) #f) #f report))

52 (error "closed policy accepted work"))

53(display "DISPATCH=PASS serialized yielding calls routed replies terminal cancellation\n")

55;; A failed async scope cancels its waiters before terminal application cleanup.

56(define failed-owner (make-dispatcher))

57(define scope-failed? #f)

58(define terminal-cancelled 0)

59(guard (exception (#t (set! scope-failed? #t)))

60 (with-async

61 (go (dispatcher-wait! failed-owner))

62 (go

63 (sleep 0.01)

64 ;; Keep this job queued while its owner's waiter is being unwound.

65 (dispatcher-enqueue! failed-owner (lambda (ignored) (error "terminal job ran")) #f report

66 on-cancel: (lambda (exception) (set! terminal-cancelled (+ terminal-cancelled 1))))

67 (error "expected dispatcher scope failure"))))

68(dispatcher-close! failed-owner)

69(dispatcher-close! failed-owner)

70(unless (and scope-failed? (dispatcher-closed? failed-owner) (= terminal-cancelled 1))

71 (error "terminal dispatcher cancellation failed"))

72(display "DISPATCH_UNWIND=PASS cancelled waiters closed outside scheduler exactly once\n")