Changeset 15517 in project

Timestamp:

08/19/09 21:03:09 (11 years ago)

Author:

sjamaan

Message:

Implement transaction support (including nested transactions)

Location:

release/4/postgresql/trunk

Files:

• postgresql.scm (modified) (4 diffs)
• tests/run.scm (modified) (1 diff)

release/4/postgresql/trunk/postgresql.scm

@@ -27 +27 @@
   connect reset-connection disconnect connection?
   
-  multi-query query query*
+  multi-query query query* with-transaction in-transaction?
   
   result? clear-result! row-count column-count
@@ -218 +218 @@
 ;;;;;;;;;;;;;;;;;;;;
 
-(define-record pg-connection ptr type-parsers oid-parsers type-unparsers)
+(define-record
+  pg-connection ptr
+  type-parsers oid-parsers type-unparsers
+  transaction-depth)
 (define connection? pg-connection?)
 
@@ -275 +278 @@
      (else
       (let ((conn (make-pg-connection conn-ptr type-parsers
-                                      (make-hash-table) type-unparsers)))
+                                      (make-hash-table) type-unparsers 0)))
         ;; We don't want libpq to piss in our stderr stream
         ((foreign-lambda* void ((pgconn* conn))
@@ -621 +624 @@
                          conn query params format))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Transaction management
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (with-transaction conn thunk)
+  (let* ((old-depth (pg-connection-transaction-depth conn))
+         (rollback!
+          (lambda ()
+            (if (= old-depth 0)
+                (query conn "ROLLBACK")
+                ;; We do not *need* to give savepoints unique names,
+                ;; but it aids debugging and we know the depth anyway.
+                (query conn (conc "ROLLBACK TO SAVEPOINT s_" old-depth)))))
+         (commit!
+          (lambda ()
+            (if (= old-depth 0)
+                (query conn "COMMIT")
+                (query conn (conc "RELEASE SAVEPOINT s_" old-depth))))))
+    (if (= old-depth 0)
+        (query conn "BEGIN")
+        (query conn (conc "SAVEPOINT s_" old-depth)))
+    (pg-connection-transaction-depth-set! conn (add1 old-depth))
+    ;; TODO: Add a warning mechanism (using dynamic-wind) for when the
+    ;; user tries to jump into/out of transactions with continuations?
+    (handle-exceptions exn
+      (begin
+        (pg-connection-transaction-depth-set! conn old-depth)
+        (rollback!)
+        (raise exn))
+      (let ((res (thunk)))
+        (pg-connection-transaction-depth-set! conn old-depth)
+        (if res (commit!) (rollback!))
+        res))))
+
+(define (in-transaction? conn)
+  (> (pg-connection-transaction-depth conn) 0))
+
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Value escaping

release/4/postgresql/trunk/tests/run.scm

@@ -342 +342 @@
          (query conn
                 "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))))
+
+(test-group "transactions"
+  (query conn "CREATE TEMP TABLE foo ( bar integer )")
+
+  (test-group "simple transactions"
+    (test "Transaction inactive"
+          #f
+          (in-transaction? conn))
+    (test "Transaction active"
+          #t
+          (with-transaction conn
+                            (lambda () (in-transaction? conn))))
+    (test "Successful transaction"
+          '(1)
+          (and
+           (with-transaction
+            conn (lambda ()
+                   (query conn "INSERT INTO foo (bar) VALUES (1)")))
+           (column-values (query conn "SELECT * FROM foo"))))
+  
+    (query conn "TRUNCATE foo")
+  
+    (test "Unsuccessful transaction"
+          #f
+          (with-transaction
+           conn (lambda ()
+                  (query conn "INSERT INTO foo (bar) VALUES (1)")
+                  #f)))
+
+    (test "Empty table after unsuccessful transaction"
+          '()
+          (column-values (query conn "SELECT * FROM foo")))
+
+    (handle-exceptions exn
+      (void)
+      (with-transaction
+       conn (lambda ()
+              (query conn "INSERT INTO foo (bar) VALUES (1)")
+              (error "oops!"))))
+  
+    (test "Exception during transaction causes reset"
+          '()
+          (column-values (query conn "SELECT * FROM foo"))))
+
+  (test-group "nested transactions"
+    (test "Successful transaction"
+          '(1 2)
+          (and
+           (with-transaction
+            conn (lambda ()
+                   (query conn "INSERT INTO foo (bar) VALUES (1)")
+                   (with-transaction
+                    conn (lambda ()
+                           (query conn "INSERT INTO foo (bar) VALUES (2)")))))
+           (column-values (query conn "SELECT * FROM foo"))))
+    
+    (query conn "TRUNCATE foo")
+
+    (test "Unsuccessful main transaction"
+          '()
+          (and
+           (not
+            (with-transaction
+             conn (lambda ()
+                    (query conn "INSERT INTO foo (bar) VALUES (1)")
+                    (with-transaction
+                     conn (lambda ()
+                            (query conn "INSERT INTO foo (bar) VALUES (2)")))
+                    #f)))
+           (column-values (query conn "SELECT * FROM foo"))))
+    
+    (test "Unsuccessful subtransaction"
+          '(1)
+          (and
+           (with-transaction
+            conn (lambda ()
+                   (query conn "INSERT INTO foo (bar) VALUES (1)")
+                   (with-transaction
+                    conn (lambda ()
+                           (query conn "INSERT INTO foo (bar) VALUES (2)")
+                           #f))
+                   #t))
+           (column-values (query conn "SELECT * FROM foo"))))
+
+    (query conn "TRUNCATE foo")
+
+    (test "Multiple subtransactions"
+          '(1 3)
+          (and
+           (with-transaction
+            conn (lambda ()
+                   (query conn "INSERT INTO foo (bar) VALUES (1)")
+                   (with-transaction
+                    conn (lambda ()
+                           (query conn "INSERT INTO foo (bar) VALUES (2)")
+                           #f))
+                   (with-transaction
+                    conn (lambda ()
+                           (query conn "INSERT INTO foo (bar) VALUES (3)")))))
+           (column-values (query conn "SELECT * FROM foo")))))
+  )