suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

db: fix finalization bug

Browse Source
This commit is contained in:
Ryan Culpepper 2012-10-22 13:18:52 -04:00
parent b61f1789c7
commit 8226899df3
3 changed files with 16 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/db/private/odbc/connection.rkt
View File

@ -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)))))
;; ----------------------------------------

9
collects/db/private/sqlite3/connection.rkt
View File

@ -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)))))
;; ----------------------------------------

64
collects/tests/db/programs/sl-gc-crash.rkt
View File

@ -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!)))