From 5a8a0aff022c3f7d2ffb95e78a25ab9d53a4f90f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 20 Jan 2015 13:04:23 -0700
Subject: [PATCH] db: fix finalization problems

A `this%` expression used in a finalization callback implicitly
referred to `this`, since it's a dynamic reference to the object's
class. As a result, the finalizer for `this` refers to `this`, so
`this` never becomes collectable. The problem is fixed by
lifting the `this%` out of the `lambda`.

Less significantly, the finalizer thread in "prepared.rkt" captured
various parameters on creation, including the current namespace. If a
prepared statement is bound to a module-level variable, then the
finalizer thread refers through the namespace to the prepared
statement, so the prepared statement can never be finalized. Setting
the current namespace to a fresh empty one while creating the thread
avoids that specific problem. (Other parameters could cause similar
problems, but solving the namespace one works well enough for now.)
---
 .../collects/db/private/generic/prepared.rkt  | 33 ++++++++++---------
 .../db/private/sqlite3/connection.rkt         | 18 +++++-----
 2 files changed, 27 insertions(+), 24 deletions(-)

diff --git a/racket/collects/db/private/generic/prepared.rkt b/racket/collects/db/private/generic/prepared.rkt
index 3dbc6142e8..af52bb8a5f 100644
--- a/racket/collects/db/private/generic/prepared.rkt
+++ b/racket/collects/db/private/generic/prepared.rkt
@@ -102,18 +102,21 @@
 (define will-executor (make-will-executor))
 
 (define finalizer-thread
-  (thread/suspend-to-kill
-   (lambda ()
-     (let loop ()
-       (with-handlers
-           ([(lambda (e) #t)
-             (lambda (e)
-               ((error-display-handler)
-                (cond [(exn? e)
-                       (format "prepared statement finalizer thread handled exception:\n~a"
-                               (exn-message e))]
-                      [else
-                       "prepared statement finalizer thread handled non-exception"])
-                e))])
-         (will-execute will-executor))
-       (loop)))))
+  ;; Set parameters for the new thread to avoid references to the
+  ;; namespace, since prepared statements may be bound to globals, etc.
+  (parameterize ([current-namespace (make-empty-namespace)])
+    (thread/suspend-to-kill
+     (lambda ()
+       (let loop ()
+         (with-handlers
+             ([(lambda (e) #t)
+               (lambda (e)
+                 ((error-display-handler)
+                  (cond [(exn? e)
+                         (format "prepared statement finalizer thread handled exception:\n~a"
+                                 (exn-message e))]
+                        [else
+                         "prepared statement finalizer thread handled non-exception"])
+                  e))])
+           (will-execute will-executor))
+         (loop))))))
diff --git a/racket/collects/db/private/sqlite3/connection.rkt b/racket/collects/db/private/sqlite3/connection.rkt
index fb27890a25..97ba750362 100644
--- a/racket/collects/db/private/sqlite3/connection.rkt
+++ b/racket/collects/db/private/sqlite3/connection.rkt
@@ -374,16 +374,16 @@
       (handle-status* who full-s -db db-spec pst))
 
     ;; ----
-
     (super-new)
-    (register-finalizer-and-custodian-shutdown this
-                        (lambda (obj)
-                          ;; Keep a reference to the class to keep all FFI callout objects
-                          ;; (eg, sqlite3_close) used by its methods from being finalized.
-                          (let ([dont-gc this%])
-                            (send obj disconnect)
-                            ;; Dummy result to prevent reference from being optimized away
-                            dont-gc)))))
+    (register-finalizer-and-custodian-shutdown
+     this
+     ;; Keep a reference to the class to keep all FFI callout objects
+     ;; (eg, sqlite3_close) used by its methods from being finalized.
+     (let ([dont-gc this%])
+       (lambda (obj)
+         (send obj disconnect)
+         ;; Dummy result to prevent reference from being optimized away
+         dont-gc)))))
 
 ;; ----------------------------------------