diff --git a/collects/db/private/generic/interfaces.rkt b/collects/db/private/generic/interfaces.rkt index 9ac8eaf7c9..c8ad693a70 100644 --- a/collects/db/private/generic/interfaces.rkt +++ b/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) diff --git a/collects/db/private/odbc/connection.rkt b/collects/db/private/odbc/connection.rkt index b96ef2f293..df9e2beb7f 100644 --- a/collects/db/private/odbc/connection.rkt +++ b/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 diff --git a/collects/db/private/sqlite3/connection.rkt b/collects/db/private/sqlite3/connection.rkt index 3fb1c65d80..523d4336a5 100644 --- a/collects/db/private/sqlite3/connection.rkt +++ b/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 - (let ([db -db] - [statements (hash-map statement-table (lambda (k v) k))]) - (set! -db #f) - (set! statement-table #f) - (for ([pst (in-list statements)]) - (let ([stmt (send pst get-handle)]) - (when stmt - (send pst set-handle #f) - (HANDLE 'disconnect (sqlite3_finalize stmt))))) - (HANDLE 'disconnect (sqlite3_close db)) - (void)))) + (start-atomic) + (let ([db -db]) + (set! -db #f) + (end-atomic) + (when db + (let ([statements (hash-map statement-table (lambda (k v) k))]) + (for ([pst (in-list statements)]) + (do-free-statement 'disconnect pst)) + (HANDLE 'disconnect2 (sqlite3_close db)) + (void))))) (call-with-lock* 'disconnect go go #f)) (define/public (get-base) this) (define/public (free-statement pst) - (define (go) - (let ([stmt (send pst get-handle)]) - (when stmt - (send pst set-handle #f) - (HANDLE 'free-statement (sqlite3_finalize stmt)) - (void)))) + (define (go) (do-free-statement 'free-statement pst)) (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)) diff --git a/collects/db/private/sqlite3/ffi.rkt b/collects/db/private/sqlite3/ffi.rkt index a0c4d5e3ab..94db428b6d 100644 --- a/collects/db/private/sqlite3/ffi.rkt +++ b/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)) + ;; ---------------------------------------- #|