test to check that callbacks are in atomic mode

This commit is contained in:
Matthew Flatt 2021-01-31 07:39:30 -07:00
parent 53b3cc5eb4
commit fd642d2715

View File

@ -9,6 +9,7 @@
ffi/unsafe/define
ffi/unsafe/define/conventions
ffi/unsafe/global
ffi/unsafe/atomic
ffi/vector
racket/extflonum
racket/place
@ -339,13 +340,18 @@
;; test sending a callback for C to hold, preventing the callback from GCing
(let ([with-keeper
(lambda (k)
(define (sqr x)
(when (eq? (system-type 'vm) 'chez-scheme)
(test #t in-atomic-mode?))
(* x x))
(t (void) 'grab_callback
(_fun (_fun #:keep k _int -> _int) -> _void) sqr)
(t 9 'use_grabbed_callback (_fun _int -> _int) 3)
(collect-garbage) ; make sure it survives a GC
(t 25 'use_grabbed_callback (_fun _int -> _int) 5)
(collect-garbage)
(t 81 'use_grabbed_callback (_fun _int -> _int) 9))])
(t 81 'use_grabbed_callback (_fun _int -> _int) 9)
(void/reference-sink sqr))])
(with-keeper #t)
(let ([b (box #f)])
(with-keeper b)