ffi/unsafe: defend against some finalization bugs

mflatt · rmculpepper · commit ee0da81dc0d8 · 2012-10-22T11:52:40.000-04:00
Turn use of a finalized ffi callout into a reported error, instead of a crash. Clarify the existence of the finalizer in the docs. Fix error logging of the finalizer thread. Merge to v5.3.1 (cherry picked from commit 9708a01)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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);
 }
