db: fixed issues with statement finalization (don't use weak hash)

In some cases, statements were disappearing from statement-table
without being finalized; this makes disconnect fail.
(I was only able to produce the problem when the db lib was
instantiated in a sub custodian that is later shutdown....
like the way the rackunit gui runs the test suite.)

collects/db/private/generic/interfaces.rkt

@@ -90,7 +90,6 @@
 
     ;; extension hooks: usually shouldn't need to override
     finalize           ;; -> void
-    register-finalizer ;; -> void
 
     ;; inspection only
     get-param-types    ;; -> (listof TypeDesc)

collects/db/private/odbc/connection.rkt

@@ -3,6 +3,7 @@
          racket/list
          racket/math
          ffi/unsafe
+         ffi/unsafe/atomic
          "../generic/interfaces.rkt"
          "../generic/prepared.rkt"
          "../generic/sql-data.rkt"
@@ -24,7 +25,7 @@
                   char-mode)
     (init strict-parameter-types?)
 
-    (define statement-table (make-weak-hasheq))
+    (define statement-table (make-hasheq))
     (define lock (make-semaphore 1))
 
     (define use-describe-param?
@@ -437,13 +438,14 @@
 
     (define/public (disconnect)
       (define (go)
+        (start-atomic)
         (let ([db* db]
               [env* env])
+          (set! db #f)
+          (set! env #f)
+          (end-atomic)
           (when db*
             (let ([statements (hash-map statement-table (lambda (k v) k))])
-              (set! db #f)
-              (set! env #f)
-              (set! statement-table #f)
               (for ([pst (in-list statements)])
                 (free-statement* 'disconnect pst))
               (handle-status 'disconnect (SQLDisconnect db*) db*)
@@ -459,11 +461,14 @@
       (call-with-lock* 'free-statement go go #f))
 
     (define/private (free-statement* fsym pst)
+      (start-atomic)
       (let ([stmt (send pst get-handle)])
+        (send pst set-handle #f)
+        (end-atomic)
         (when stmt
-          (send pst set-handle #f)
           (handle-status 'free-statement (SQLFreeStmt stmt SQL_CLOSE) stmt)
           (handle-status 'free-statement (SQLFreeHandle SQL_HANDLE_STMT stmt) stmt)
+          (hash-remove! statement-table pst)
           (void))))
 
     ;; Transactions

collects/db/private/sqlite3/connection.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require racket/class
          ffi/unsafe
+         ffi/unsafe/atomic
          "../generic/interfaces.rkt"
          "../generic/prepared.rkt"
          "../generic/sql-data.rkt"
@@ -18,7 +19,7 @@
                   busy-retry-delay)
 
     (define -db db)
-    (define statement-table (make-weak-hasheq))
+    (define statement-table (make-hasheq))
     (define saved-tx-status #f) ;; set by with-lock, only valid while locked
 
     (inherit call-with-lock*
@@ -149,33 +150,35 @@
           pst)))
 
     (define/public (disconnect)
-      ;; FIXME: Reorder effects to be more robust if thread killed within disconnect (?)
       (define (go)
-        (when -db
+        (start-atomic)
-          (let ([db -db]
+        (let ([db -db])
-                [statements (hash-map statement-table (lambda (k v) k))])
+          (set! -db #f)
-            (set! -db #f)
+          (end-atomic)
-            (set! statement-table #f)
+          (when db
-            (for ([pst (in-list statements)])
+            (let ([statements (hash-map statement-table (lambda (k v) k))])
-              (let ([stmt (send pst get-handle)])
+              (for ([pst (in-list statements)])
-                (when stmt
+                (do-free-statement 'disconnect pst))
-                  (send pst set-handle #f)
+              (HANDLE 'disconnect2 (sqlite3_close db))
-                  (HANDLE 'disconnect (sqlite3_finalize stmt)))))
+              (void)))))
-            (HANDLE 'disconnect (sqlite3_close db))
-            (void))))
       (call-with-lock* 'disconnect go go #f))
 
     (define/public (get-base) this)
 
     (define/public (free-statement pst)
-      (define (go)
+      (define (go) (do-free-statement 'free-statement pst))
-        (let ([stmt (send pst get-handle)])
-          (when stmt
-            (send pst set-handle #f)
-            (HANDLE 'free-statement (sqlite3_finalize stmt))
-            (void))))
       (call-with-lock* 'free-statement go go #f))
 
+    (define/private (do-free-statement fsym pst)
+      (start-atomic)
+      (let ([stmt (send pst get-handle)])
+        (send pst set-handle #f)
+        (end-atomic)
+        (hash-remove! statement-table pst)
+        (when stmt
+          (HANDLE fsym (sqlite3_finalize stmt))
+          (void))))
+
 
     ;; == Transactions
 
@@ -262,7 +265,7 @@
     ;; Can't figure out how to test...
     (define/private (handle-status who s)
       (when (memv s maybe-rollback-status-list)
-        (when (and saved-tx-status (not (get-tx-status -db))) ;; was in trans, now not
+        (when (and saved-tx-status -db (not (get-tx-status -db))) ;; was in trans, now not
           (set! tx-status 'invalid)))
       (handle-status* who s -db))
 

collects/db/private/sqlite3/ffi.rkt

@@ -132,6 +132,14 @@
   (_fun _sqlite3_database
         -> _bool))
 
+(define-sqlite sqlite3_next_stmt
+  (_fun _sqlite3_database _sqlite3_statement/null
+        -> _sqlite3_statement/null))
+
+(define-sqlite sqlite3_sql
+  (_fun _sqlite3_statement
+        -> _string))
+
 ;; ----------------------------------------
 
 #|