diff --git a/collects/db/private/odbc/connection.rkt b/collects/db/private/odbc/connection.rkt index 30414008f9..5f23a1c5c2 100644 --- a/collects/db/private/odbc/connection.rkt +++ b/collects/db/private/odbc/connection.rkt @@ -656,7 +656,14 @@ #:on-notice add-notice!))) (super-new) - (register-finalizer this (lambda (obj) (send obj disconnect))))) + (register-finalizer this + (lambda (obj) + ;; Keep a reference to the class to keep all FFI callout objects + ;; (eg, SQLDisconnect) 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))))) ;; ---------------------------------------- diff --git a/collects/db/private/sqlite3/connection.rkt b/collects/db/private/sqlite3/connection.rkt index 5a716249cc..a4d04423fb 100644 --- a/collects/db/private/sqlite3/connection.rkt +++ b/collects/db/private/sqlite3/connection.rkt @@ -316,7 +316,14 @@ ;; ---- (super-new) - (register-finalizer this (lambda (obj) (send obj disconnect))))) + (register-finalizer 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))))) ;; ---------------------------------------- diff --git a/collects/tests/db/programs/sl-gc-crash.rkt b/collects/tests/db/programs/sl-gc-crash.rkt deleted file mode 100644 index 18db92e8a6..0000000000 --- a/collects/tests/db/programs/sl-gc-crash.rkt +++ /dev/null @@ -1,64 +0,0 @@ -#lang racket -(require ffi/unsafe/define - ffi/unsafe) - -#| -Open this program in DrRacket. -Click Run and then eval (collect-garbage) in the interaction area. -Repeat a few times, and eventually DrRacket will crash with a -segmentation fault. - -No crash in 5.1, 5.1.1 -Crashes in 5.2, 5.2.1, 5.3, 5.3.1.1 - -git bisect says introduced here: 2ada6d0e89a763f3b8523a87e580b1ffb25430eb -|# - -;; NOTE: make sure file exists by running "touch $filename" -(define filename #"/tmp/my.db") - -;; set NEXT-STMT? for another variation of the test, which does actually -;; seem to invoke the proper function, unlike sqlite3_close (???) -(define NEXT-STMT? #f) - -(define-ffi-definer define-sqlite - (ffi-lib "libsqlite3" '("0" #f))) - -(define-cpointer-type _sqlite3_database) -(define-cpointer-type _sqlite3_statement) - -(define SQLITE_OPEN_READWRITE #x00000002) - -(define-sqlite sqlite3_open_v2 - (_fun (filename flags) :: - (filename : _bytes) - (db : (_ptr o _sqlite3_database)) - (flags : _int) - (vfs : _pointer = #f) - -> (result : _int) - -> (values db result))) - -(define-sqlite sqlite3_close - (_fun _sqlite3_database - -> _int)) - -(define-sqlite sqlite3_next_stmt - (_fun _sqlite3_database _sqlite3_statement/null -> _sqlite3_statement/null)) - -(define c% - (class object% - (super-new) - - (define-values (db status) - (sqlite3_open_v2 filename SQLITE_OPEN_READWRITE)) - - (unless (zero? status) - (eprintf "open got ~s\n" status)) - - (define/public (finalize!) - (when NEXT-STMT? (sqlite3_next_stmt db #f)) - (sqlite3_close db)) - )) - -(define p (new c%)) -(register-finalizer p (lambda (v) (send v finalize!)))