diff --git a/collects/db/base.rkt b/collects/db/base.rkt index 4a6e137a26..d6056810e5 100644 --- a/collects/db/base.rkt +++ b/collects/db/base.rkt @@ -146,7 +146,7 @@ [call-with-transaction (->* (connection? (-> any)) (#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f)) - void?)] + any)] [prop:statement (struct-type-property/c diff --git a/collects/db/private/postgresql/connection.rkt b/collects/db/private/postgresql/connection.rkt index a6d4d23a0a..dbdc8ea1e6 100644 --- a/collects/db/private/postgresql/connection.rkt +++ b/collects/db/private/postgresql/connection.rkt @@ -436,7 +436,8 @@ ;; 'read-write => "READ WRITE" (if isolation-level (string-append "BEGIN WORK ISOLATION LEVEL " isolation-level) - "BEGIN WORK")))) + "BEGIN WORK"))) + (void)) (define/public (end-transaction fsym mode) (internal-query fsym diff --git a/collects/tests/db/db/query.rkt b/collects/tests/db/db/query.rkt index c396daf566..50ac048e16 100644 --- a/collects/tests/db/db/query.rkt +++ b/collects/tests/db/db/query.rkt @@ -252,6 +252,37 @@ sql-null 18 19 20 sql-null sql-null sql-null sql-null sql-null sql-null 27 28 29 30 sql-null 32 33 sql-null 35))))))) +(define tx-tests + (test-suite "transaction functions" + (test-case "start, commit" + (with-connection c + (check-pred void? (start-transaction c)) + (check-equal? (in-transaction? c) #t) + (check-pred void? (commit-transaction c)) + (check-equal? (in-transaction? c) #f))) + (test-case "start, rollback" + (with-connection c + (check-pred void? (start-transaction c)) + (check-equal? (in-transaction? c) #t) + (check-pred void? (rollback-transaction c)) + (check-equal? (in-transaction? c) #f))) + (test-case "error on repeated start" + (with-connection c + (start-transaction c) + (check-exn #rx"already in transaction" + (lambda () (start-transaction c))))) + (test-case "call-with-tx" + (with-connection c + (check-equal? (call-with-transaction c + (lambda () + (check-equal? (in-transaction? c) #t) + 'ok)) + 'ok) + (check-equal? (call-with-values + (lambda () (call-with-transaction c (lambda () (values 1 2 3)))) + list) + (list 1 2 3)))))) + (define error-tests (test-suite "errors" (test-case "query - not a statement" @@ -342,6 +373,7 @@ (simple-tests 'bind) (simple-tests 'gen) low-level-tests + tx-tests misc-tests virtual-statement-tests pool-tests