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

db: remove custodian registration on disconnect

Browse Source
This commit is contained in:
Ryan Culpepper 2017-08-21 21:56:39 -04:00
parent e61d8aa1b2
commit 09e90c65dc
1 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
racket/collects/db/private/sqlite3/connection.rkt
View File

@ -23,6 +23,7 @@
(define -db db) (define -db db)
(define saved-tx-status #f) ;; set by with-lock, only valid while locked (define saved-tx-status #f) ;; set by with-lock, only valid while locked
(define creg #f) ;; custodian registration
(sqlite3_extended_result_codes db #t) (sqlite3_extended_result_codes db #t)
@ -243,11 +244,17 @@
(define/override (disconnect* _politely?) (define/override (disconnect* _politely?)
(super disconnect* _politely?) (super disconnect* _politely?)
(real-disconnect #f))
(define/public (real-disconnect from-custodian?)
(call-as-atomic (call-as-atomic
(lambda () (lambda ()
(let ([db -db]) (let ([db -db])
(when db (when db
(set! -db #f) (set! -db #f)
;; Unregister custodian shutdown, unless called from custodian.
(unless from-custodian? (unregister-custodian-shutdown this creg))
(set! creg #f)
;; Free all of connection's prepared statements. This will leave ;; Free all of connection's prepared statements. This will leave
;; pst objects with dangling foreign objects, so don't try to free ;; pst objects with dangling foreign objects, so don't try to free
;; them again---check that -db is not-#f. ;; them again---check that -db is not-#f.
@ -388,15 +395,16 @@
;; ---- ;; ----
(super-new) (super-new)
(register-finalizer-and-custodian-shutdown (let ([shutdown
this ;; Keep a reference to the class to keep all FFI callout objects
;; Keep a reference to the class to keep all FFI callout objects ;; (eg, sqlite3_close) used by its methods from being finalized.
;; (eg, sqlite3_close) used by its methods from being finalized. (let ([dont-gc this%])
(let ([dont-gc this%]) (lambda (obj)
(lambda (obj) (send obj real-disconnect #t)
(send obj disconnect* #f) ;; Dummy result to prevent reference from being optimized away
;; Dummy result to prevent reference from being optimized away dont-gc))])
dont-gc))))) (register-finalizer this shutdown)
(set! creg (register-custodian-shutdown this shutdown)))))
;; ---------------------------------------- ;; ----------------------------------------