From e3eed89b1d85de92072939b002ac5db1615ee9c4 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 6 Jul 2013 07:19:42 -0600
Subject: [PATCH] fix GC bug in FFI

A foreign procedure's data could get GCed before the procedure
was called, if the procedure is not otherwise reachable.

(Bug found by running tests in GC-stress mode.)
---
 racket/src/foreign/foreign.c    | 5 +++++
 racket/src/foreign/foreign.rktc | 5 +++++
 2 files changed, 10 insertions(+)

diff --git a/racket/src/foreign/foreign.c b/racket/src/foreign/foreign.c
index f5ab2c46bd..2c225b4ba1 100644
--- a/racket/src/foreign/foreign.c
+++ b/racket/src/foreign/foreign.c
@@ -3369,6 +3369,11 @@ Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object *self)
                     nargs, ivals, avalues,
                     offsets, p);
 
+  /* Use `data' to make sure it's kept alive (as far as the GC is concerned)
+     until the foreign call returns: */
+  if ((void*)data == (void*)scheme_true)
+    scheme_signal_error("dummy test suceeded!?");
+
   if (save_errno != 0) save_errno_values(save_errno);
   ivals = NULL; /* no need now to hold on to this */
   for (i=0; i<nargs; i++) { avalues[i] = NULL; } /* no need for these refs */
diff --git a/racket/src/foreign/foreign.rktc b/racket/src/foreign/foreign.rktc
index 4205c86fd3..752179bf4a 100755
--- a/racket/src/foreign/foreign.rktc
+++ b/racket/src/foreign/foreign.rktc
@@ -2576,6 +2576,11 @@ Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object *self)
                     nargs, ivals, avalues, 
                     offsets, p);
 
+  /* Use `data' to make sure it's kept alive (as far as the GC is concerned)
+     until the foreign call returns: */
+  if ((void*)data == (void*)scheme_true)
+    scheme_signal_error("dummy test suceeded!?");
+
   if (save_errno != 0) save_errno_values(save_errno);
   ivals = NULL; /* no need now to hold on to this */
   for (i=0; i<nargs; i++) { avalues[i] = NULL; } /* no need for these refs */