diff --git a/collects/ffi/unsafe.rkt b/collects/ffi/unsafe.rkt index 43a6b225ae..37ffc7c12b 100644 --- a/collects/ffi/unsafe.rkt +++ b/collects/ffi/unsafe.rkt @@ -1702,6 +1702,7 @@ (cweh (lambda (exn) (log-message logger + 'error (if (exn? exn) (exn-message exn) (format "~s" exn)) diff --git a/collects/scribblings/foreign/types.scrbl b/collects/scribblings/foreign/types.scrbl index 1ea8ebdaea..a13870cce1 100644 --- a/collects/scribblings/foreign/types.scrbl +++ b/collects/scribblings/foreign/types.scrbl @@ -485,6 +485,11 @@ For @tech{callouts} to foreign functions with the generated type: that values managed by the Racket garbage collector might be moved in memory by the garbage collector.} + @item{A @tech{callout} object is finalized internally. Beware + of trying to use a @tech{callout} object that is reachable + only from a finalized object, since the two objects + might be finalized in either order.} + ] For @tech{callbacks} to Racket functions with the generated type: diff --git a/collects/tests/racket/ffi-call-final.rkt b/collects/tests/racket/ffi-call-final.rkt new file mode 100644 index 0000000000..4993ee27f8 --- /dev/null +++ b/collects/tests/racket/ffi-call-final.rkt @@ -0,0 +1,32 @@ +#lang racket/base + +;; Check for a good effort at error reporting on an attempt to +;; use a foreign function that is finalized already. + +(define src + '(module m racket/base + (require ffi/unsafe) + (for ([i 10]) + (for ([i 10]) + (define m (get-ffi-obj 'fabs #f (_fun _double -> _double))) + ;; Since `m' is accessible only via the finalized value, it + ;; can be finalized before `(list m)': + (register-finalizer (list m) (lambda (p) ((car p) 10.0)))) + (collect-garbage)))) + +(define l (make-logger)) +(define r (make-log-receiver l 'error)) + +(parameterize ([current-namespace (make-base-namespace)] + [current-logger l]) + (eval src) + (namespace-require ''m)) + +;; Print logged errors, of which there are likely to be +;; some (although it's not guaranteed) if the finalizer +;; thread is logging correctly: +(let loop () + (define m (sync/timeout 0 r)) + (when m + (printf "~s\n" m) + (loop))) diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c index d55c77d98d..ba085986ec 100644 --- a/src/foreign/foreign.c +++ b/src/foreign/foreign.c @@ -3055,7 +3055,7 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[]) #ifdef MZ_USE_PLACES int orig_place = SCHEME_TRUEP(SCHEME_VEC_ELS(data)[7]); #endif - int nargs = cif->nargs; + int nargs /* = cif->nargs, after checking cif */; /* When the foreign function is called, we need an array (ivals) of nargs * ForeignAny objects to store the actual C values that are created, and we * need another array (avalues) for the pointers to these values (this is @@ -3082,6 +3082,13 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[]) if (orig_place && (scheme_current_place_id == 0)) orig_place = 0; #endif + if (!cif) { + scheme_signal_error("ffi-call: foreign-function reference was already finalized%s%s", + name ? "\n name: " : "", + name ? name : ""); + return NULL; + } + nargs = cif->nargs; if ((nargs <= MAX_QUICK_ARGS)) { ivals = stack_ivals; avalues = stack_avalues; @@ -3151,8 +3158,9 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[]) } /* see below */ -void free_fficall_data(void *ignored, void *p) +void free_fficall_data(void *data, void *p) { + SCHEME_VEC_ELS(data)[4] = NULL; free(((ffi_cif*)p)->arg_types); free(p); } diff --git a/src/foreign/foreign.rktc b/src/foreign/foreign.rktc index 702db57354..e70e2a423c 100755 --- a/src/foreign/foreign.rktc +++ b/src/foreign/foreign.rktc @@ -2411,7 +2411,7 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[]) #ifdef MZ_USE_PLACES int orig_place = SCHEME_TRUEP(SCHEME_VEC_ELS(data)[7]); #endif - int nargs = cif->nargs; + int nargs /* = cif->nargs, after checking cif */; /* When the foreign function is called, we need an array (ivals) of nargs * ForeignAny objects to store the actual C values that are created, and we * need another array (avalues) for the pointers to these values (this is @@ -2438,6 +2438,13 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[]) if (orig_place && (scheme_current_place_id == 0)) orig_place = 0; #endif + if (!cif) { + scheme_signal_error("ffi-call: foreign-function reference was already finalized%s%s", + name ? "\n name: " : "", + name ? name : ""); + return NULL; + } + nargs = cif->nargs; if ((nargs <= MAX_QUICK_ARGS)) { ivals = stack_ivals; avalues = stack_avalues; @@ -2507,8 +2514,9 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[]) } /* see below */ -void free_fficall_data(void *ignored, void *p) +void free_fficall_data(void *data, void *p) { + SCHEME_VEC_ELS(data)[4] = NULL; free(((ffi_cif*)p)->arg_types); free(p); }