Changeset 14569 in project


Ignore:
Timestamp:
05/08/09 21:54:16 (11 years ago)
Author:
Jim Ursetto
Message:

sql-de-lite: add db error status to exceptions; reset statements on busy; reduce mutations

Location:
release/4/sql-de-lite/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/sql-de-lite/trunk/sql-de-lite.scm

    r14299 r14569  
    1111   *(C_word*)(C_data_pointer(ctx)) = C_SCHEME_TRUE;
    1212   return 0;
    13 }                                                     
     13}
    1414<#
    1515
     
    1717
    1818(module sql-de-lite
    19 ;;  *
    2019    (
    2120     error-code error-message
    2221     open-database close-database
    2322     prepare prepare-transient
    24      finalize step ; step-through
     23     finalize resurrect
     24     step ; step-through
    2525     fetch fetch-alist
    2626     fetch-all first-column
     
    4646     raise-database-errors
    4747     prepared-cache-size
    48    
     48
    4949     ;; experimental interface
    5050     for-each-row for-each-row*
     
    5454     flush-cache!
    5555
     56     ;; exceptions
     57     sqlite-exception?
     58     sqlite-exception-status
     59     sqlite-exception-message
     60
    5661     finalized?
    57                
    5862     )
    5963
     
    199203  (define (statement-run-state s)
    200204    (handle-run-state (statement-handle s)))
    201   (define (set-statement-run-state! s b)
    202     (set-handle-run-state! (statement-handle s) b))
    203 
     205  ;; use an int instead of symbol; this is internal, and avoids mutations
     206  (define (statement-reset? s)
     207    (= 0 (handle-run-state (statement-handle s))))
     208  (define (statement-running? s)
     209    (= 1 (handle-run-state (statement-handle s))))
     210  (define (statement-done? s)
     211    (= 2 (handle-run-state (statement-handle s))))
     212  (define (set-statement-reset! s)
     213    (set-handle-run-state! (statement-handle s) 0))
     214  (define (set-statement-running! s)
     215    (set-handle-run-state! (statement-handle s) 1))
     216  (define (set-statement-done! s)
     217    (set-handle-run-state! (statement-handle s) 2))
     218 
    204219  (define-inline (nonnull-statement-ptr stmt)
    205220    ;; All references to statement ptr implicitly check for valid db.
     
    248263        (let ((c (current-exception-handler)))
    249264          (with-exception-handler
    250            (lambda (ex)  ; careful not to throw another exception in here
    251              (when (statement? s)
    252                (and-let* ((h (statement-handle s))
    253                           (ptr (handle-ptr h)))
    254                  (sqlite3_reset ptr)))
     265           (lambda (ex)    ; careful not to throw another exception in here--
     266                      ; handle-exceptions would be safer, but slower
     267             (and-let* ((statement? s)
     268                        (h (statement-handle s)) ; is this too paranoid?
     269                        (handle-ptr h))
     270               (reset-unconditionally s))
    255271             (c ex))
    256272           (lambda () (proc s))))
     
    263279         (exec* s)))
    264280  ;; Executes statement s, returning the number of changes (if the
    265   ;; result set has no columns as in INSERT, DELETE) or the first row (if
    266   ;; column data is returned as in SELECT).  Resurrection is omitted, as it
    267   ;; would wipe out any bindings.  Reset is NOT done beforehand; it is cheap,
    268   ;; but the user must reset before a bind anyway.
    269   ;; Reset afterward is not guaranteed; it is done only if a row
    270   ;; was returned and fetch did not throw an error.  An error in step
    271   ;; should not leave the statement open, but an error in retrieving column
    272   ;; data will (such as a string > 16MB)--this is a flaw.
     281  ;; result set has no columns as in INSERT, DELETE) or the first row
     282  ;; (if column data is returned as in SELECT).  Resurrection is
     283  ;; omitted, as it would wipe out any bindings.  Reset is NOT done
     284  ;; beforehand; it is cheap, but the user must reset before a bind
     285  ;; anyway.  Reset afterward is not done via unwind-protect; it will
     286  ;; be done here if a row was returned, and in step() if a database
     287  ;; error or busy occurs, but a Scheme error (such as retrieving
     288  ;; column data > 16MB) will not cause a reset.  This is a flaw,
     289  ;; but substantially faster.
    273290  (define (exec* s)
    274291    (and-let* ((v (fetch s)))
     
    357374                            (names (make-vector ncol #f)))
    358375                       (make-handle stmt ncol names nparam
    359                                     #f #f)) ; cached? run-state
     376                                    #f 0)) ; cached? run-state
    360377                     #f))     ; not an error, even when raising errors
    361378                ((= rv status/busy)
     
    365382                            (bh db times))
    366383                       (retry (+ times 1))
    367                        (database-error db 'prepare sql))))
     384                       (database-error db rv 'prepare sql))))
    368385                (else
    369                  (database-error db 'prepare sql)))))))
     386                 (database-error db rv 'prepare sql)))))))
    370387
    371388  ;; Looks up a prepared statement in the statement cache.  If not
     
    378395      (cond ((lru-cache-ref c sql)
    379396             => (lambda (s)
    380                   (case (statement-run-state s)
    381                     ((running)
    382                      (error 'prepare
    383                             "cached statement is currently executing" s))
    384                     ((done)
    385                      (reset s))
    386                     (else s))))
     397                  (cond ((statement-running? s)
     398                         (error 'prepare
     399                                "cached statement is currently executing" s))
     400                        ((statement-done? s)
     401                         (reset s))
     402                        (else s))))
    387403            ((prepare-handle db sql)
    388404             => (lambda (h)
     
    400416
    401417  ;; Returns #f on error, 'row on SQLITE_ROW, 'done on SQLITE_DONE.
    402   ;; On error, statement is reset.  However, statement is not
    403   ;; currently reset on busy.  Oddly, one of the benefits of
     418  ;; On error or busy, statement is reset.   Oddly, one of the benefits of
    404419  ;; resetting on error is a more descriptive error message; although
    405420  ;; step() returns result codes directly with prepare_v2(), it still
    406421  ;; takes a reset to convert "constraint failed" into "column key is
    407422  ;; not unique".
     423  ;; We do unconditionally reset on BUSY, after any
     424  ;; retries).  If we don't, we see weird behavior.  For example,
     425  ;; first obtain a read lock with a SELECT step, then step an
     426  ;; INSERT to get a BUSY; if the INSERT is not then reset, stepping
     427  ;; a different INSERT may "succeed", but not write
     428  ;; any data.  I assume that is an undetected MISUSE condition.
     429  ;; NB It should not be necessary to reset between calls to busy handler.
    408430  (define (step stmt)
    409431    (let ((db (statement-db stmt)))
     
    412434        (let ((rv (sqlite3_step (nonnull-statement-ptr stmt))))
    413435          (cond ((= rv status/row)
    414                  (unless (statement-run-state stmt)
    415                    (set-statement-run-state! stmt 'running))
     436                 (set-statement-running! stmt)
    416437                 'row)
    417438                ((= rv status/done)
    418                  (set-statement-run-state! stmt 'done)
     439                 (set-statement-done! stmt)
    419440                 'done)
    420                 ((= rv status/misuse) ;; Error code/msg may not be set! :(
    421                  (reset-unconditionally stmt)
    422                  (error 'step "misuse of interface"))
    423441                ;; sqlite3_step handles SCHEMA error itself.
    424442                ((= rv status/busy)
     443                 ;; "SQLITE_BUSY can only occur before fetching the first row." --drh
     444                 ;; Therefore, it is safe to reset on busy.
     445                 (set-statement-running! stmt)
    425446                 (let ((bh (db-busy-handler db)))
    426447                   (if (and bh
     
    428449                            (bh db times))
    429450                       (retry (+ times 1))
    430                        (database-error db 'step stmt))))
     451                       (begin
     452                         (reset-unconditionally stmt)
     453                         (database-error db rv 'step stmt)))))
    431454                (else
    432455                 (reset-unconditionally stmt)
    433                  (database-error db 'step stmt)))))))
     456                 (database-error db rv 'step stmt)))))))
    434457
    435458  ;; Finalize a statement.  Finalizing a finalized statement or a
     
    454477          (cond ((= rv status/abort)
    455478                 (database-error
    456                   (statement-db stmt) 'finalize))
    457                 ((= rv status/misuse)
    458                  (error 'finalize "misuse of interface"))
     479                  (statement-db stmt) rv 'finalize))
    459480                (else #t)))))
    460481
     
    464485  ;; error from sqlite3_step, so ignore any error here.
    465486  (define (reset stmt)
    466     (when (statement-run-state stmt)
     487    (when (not (statement-reset? stmt))
    467488      (reset-unconditionally stmt))
    468489    stmt)
    469490  (define (reset-unconditionally stmt)
    470491    (sqlite3_reset (nonnull-statement-ptr stmt))
    471     (set-statement-run-state! stmt #f)
     492    (set-statement-reset! stmt)
    472493    stmt)
    473494
     
    526547                    (error 'bind "invalid argument type" x)))))
    527548        (cond ((= rv status/ok) stmt)
    528               (else (database-error (statement-db stmt) 'bind))))))
     549              (else (database-error (statement-db stmt) rv 'bind))))))
    529550 
    530551  (define bind-parameter-count statement-parameter-count)
     
    617638               (loop (cons row L)))
    618639              (else
    619                (raise-database-error (statement-db s) 'fetch-all))))))
     640               ;; Semantics are odd if exception raising is disabled.
     641               (error 'fetch-all "fetch failed" s))))))
    620642
    621643;;   (define (step-through stmt)
     
    657679                                         (finalize-transient stmt))))
    658680              (if db-ptr
    659                   (database-error (make-db db-ptr filename #f #f #f)
     681                  (database-error (make-db db-ptr filename #f #f #f) rv
    660682                                  'open-database filename)
    661683                  (error 'open-database "internal error: out of memory")))))))
     
    689711  (define (error-message db)
    690712    (sqlite3_errmsg (nonnull-db-ptr db)))
    691   (define (database-error db where . args)
     713  (define (database-error db code where . args)
    692714    (and (raise-database-errors)
    693          (apply raise-database-error db where args)))
    694   (define (raise-database-error db where . args)
    695     (apply error where (error-message db) args))
     715         (apply raise-database-error db code where args)))
     716  (define (raise-database-error db code where . args)
     717    ;; status/misuse may not set the error code and message; signal
     718    ;; a generic misuse error if we believe that has happened.
     719    ;; [ref. http://www.sqlite.org/c3ref/errcode.html]
     720    (if (or (not (= code status/misuse))
     721            (eqv? (error-code db) 'misuse))
     722        (raise-database-error/status
     723         db (int->status code) where (error-message db) args)
     724        (raise-database-error/status
     725         db 'misuse where "misuse of interface" args)))
     726  (define (raise-database-error/status db status where message args)
     727    (abort
     728     (make-composite-condition
     729      (make-property-condition 'exn
     730                               'location where
     731                               'message message
     732                               'arguments args)
     733      (make-property-condition 'sqlite
     734                               'status status
     735                               'message message))))
     736  (define sqlite-exception? (condition-predicate 'sqlite))
     737  ;; note that these will return #f if you pass it a non-sqlite condition
     738  (define sqlite-exception-status (condition-property-accessor 'sqlite 'status))
     739  (define sqlite-exception-message (condition-property-accessor 'sqlite 'message))
    696740
    697741;;; Transactions
     
    713757                                                     (error 'with-transaction
    714758                                                            "rollback failed"))
    715                                                  (signal ex))
     759                                                 (abort ex))
    716760                      (let ((rv (thunk))) ; only 1 return value allowed
    717761                        (and rv
     
    765809          (if (and s
    766810                   (pointer=? (statement-ptr s) sptr))
    767               (reset s)
     811              (reset-unconditionally s)   ; in case our state is out of sync
    768812              (begin
    769813                (fprintf
  • release/4/sql-de-lite/trunk/sql-de-lite.setup

    r14299 r14569  
    44 'sql-de-lite
    55 '("sql-de-lite.so" "sql-de-lite.import.so")
    6  '((version "0.3.1")))
     6 '((version "0.3.2")))
  • release/4/sql-de-lite/trunk/test.scm

    r14035 r14569  
    11(use test)
    22(use sql-de-lite)
     3(use files) ; create-temporary-file
     4(use posix) ; delete-file
    35
    46;; Concatenate string literals into a single literal at compile time.
     
    263265              (error 'oops))))))
    264266
     267(test "Reset cached statement may be pulled from cache"
     268      #t   ; Cannot currently dig into statement to test it; just ensure no error
     269      (call-with-database 'memory
     270        (lambda (db)
     271          (let* ((sql "select 1;")
     272                 (s1 (prepare db sql))
     273                 (s2 (prepare db sql)))
     274            #t))))
     275
    265276(test "create / insert one row via execute-sql"
    266277      1
     
    282293        (finalize s)
    283294        (exec s)))))
    284  (test-error ;; operation on finalized statement
    285   "reset after finalize fails"
     295 (test
     296  "reset after finalize ok"
     297  #t
    286298  (call-with-database ":memory:"
    287299    (lambda (db)
     
    290302                db "insert into cache values('jml', 'oak');")))
    291303        (finalize s)
    292         (reset s)))))
     304        (reset s)
     305        #t))))
    293306
    294307 (test-error ;;  operation on closed database
     
    385398                   rowid))))))
    386399
     400(test-group
     401 "multiple connections"
     402 (let ((db-name (create-temporary-file "db")))
     403   (call-with-database db-name
     404     (lambda (db1)
     405       (call-with-database db-name
     406         (lambda (db2)
     407           (exec (sql db1 "create table c(k,v);"))
     408           (exec (sql db1 "create table q(k,v);"))
     409           (exec (sql db1 "insert into c(k,v) values(?,?);") "foo" "bar")
     410           (exec (sql db1 "insert into c(k,v) values(?,?);") "baz" "quux")
     411           (let ((s (prepare db1 "select * from c;"))
     412                 (ic (prepare db2 "insert into c(k,v) values(?,?);"))
     413                 (iq (prepare db2 "insert into q(k,v) values(?,?);")))
     414             (test "select step in db1" '("foo" "bar") (fetch s))
     415             (test "insert step in db2 during select in db1 returns busy"
     416                   'busy
     417                   (sqlite-exception-status
     418                    (handle-exceptions e e (exec iq "phlegm" "snot"))))
     419
     420             (test "retry the busy insert, expecting busy again"
     421                   ;; ensure statement is reset properly; if not, we will get a bind error
     422                   ;; Perform a step here to show iq is reset after BUSY in step; see next test
     423                   'busy
     424                   (sqlite-exception-status
     425                    (handle-exceptions e e (step iq))))
     426
     427             ;; (If we don't reset iq after BUSY--currently automatically done in step--
     428             ;;  then this step will mysteriously "succeed".  I suspect misuse of interface.)
     429             (test "different insert in db2 also returns busy"
     430                   'busy
     431                   (sqlite-exception-status
     432                    (handle-exceptions e e (exec ic "hyper" "meta"))))
     433             
     434             (test "another step in db1"
     435                   '("baz" "quux")
     436                   (fetch s))
     437             (test "another step in db1" '() (fetch s))
     438
     439             (test "reset and restep read in db1 ok, insert lock was reset"
     440                   '("foo" "bar")
     441                   (begin (reset s) (fetch s)))
     442
     443
     444             ;; Old tests -- step formerly did not reset on statement BUSY
     445;;              (test "reset and restep read in db1, returns BUSY due to pending insert"
     446;;                    'busy
     447;;                    (sqlite-exception-status
     448;;                     (handle-exceptions e e (reset s) (fetch s))))
     449
     450;;              (test "reset and query* fetch in s, expect BUSY, plus s should be reset by query*"
     451;;                    'busy
     452;;                    (begin
     453;;                      (reset s)
     454;;                      (sqlite-exception-status
     455;;                       (handle-exceptions e e (query* fetch s)))))
     456
     457;;              (test "reset open db2 write, reset and restep read in db1"
     458;;                    '("foo" "bar")
     459;;                    (begin (reset iq)
     460;;                           (reset s)
     461;;                           (fetch s)))
     462
     463             (test-error "prepare on executing select fails"
     464                   (begin
     465                     (step s)
     466                     (prepare db1 "select * from c;")))
     467             
     468           )))))
     469   (delete-file db-name)))
     470
    387471;;; Future tests
    388472
Note: See TracChangeset for help on using the changeset viewer.