suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

test to check that callbacks are in atomic mode

Browse Source
This commit is contained in:
Matthew Flatt 2021-01-31 07:39:30 -07:00
parent 53b3cc5eb4
commit fd642d2715
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-test-core/tests/racket/foreign-test.rktl
View File

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