From 4e39054b914612b2978c342965159a6e44b773d4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 30 Jan 2019 16:18:06 -0700 Subject: [PATCH] ffi/unsafe/objc: fix expand-time check of `(system-type 'vm)` Don't make expansion depend on `(system-type 'vm)`, because expansions should be VM-inpendent. For example, distribution builds use a single expansion and finish up from there for different Racket implementations. --- racket/collects/ffi/unsafe/objc.rkt | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/racket/collects/ffi/unsafe/objc.rkt b/racket/collects/ffi/unsafe/objc.rkt index 6b75d8efa4..732206940e 100644 --- a/racket/collects/ffi/unsafe/objc.rkt +++ b/racket/collects/ffi/unsafe/objc.rkt @@ -904,12 +904,10 @@ [(eq? (syntax-e #'id) 'dealloc) ;; so that objects can be destroyed in foreign threads: #'apply-directly] - [(eq? (system-type 'vm) 'chez-scheme) + [else ;; to cooperate with blocking callouts, we need a non-#f - ;; `async-apply` - #'complain-apply-foreign-thread] - [else - #'#f])]) + ;; `async-apply` for CS + #'maybe-complain-apply-foreign-thread])]) (syntax/loc m (kind #:async-apply async result-type (id arg ...) body0 body ...))))] [else (raise-syntax-error #f @@ -919,12 +917,14 @@ (define (apply-directly f) (f)) -(define (complain-apply-foreign-thread f) - ;; We'd like to complain, but we' not in a context where there's a - ;; valid way to complain. Try logging an error, and just maybe that - ;; will get some information out. - (log-error "callback in unexpected thread") - (void)) +(define maybe-complain-apply-foreign-thread + (and (eq? (system-type 'vm) 'chez-scheme) + (lambda (f) + ;; We'd like to complain, but we' not in a context where there's a + ;; valid way to complain. Try logging an error, and just maybe that + ;; will get some information out. + (log-error "callback in unexpected thread") + (void)))) (define methods (make-hasheq)) (define (save-method! m)