On Thu, 9 Mar 2017 09:25:14 +0100
Pavel Stehule <pavel.steh...@gmail.com> wrote:


> >
> is this patch complete? I don't see new regress tests

Oh, really! I've forgot that git diff doesn't include files which are
not added into git.

So, no old regress tests as well.

Sorry for posting incomplete patch.

Attached fixed version of patch with regress tests and couple more
whitespace issues fixed.

                 With best regards, Victor

--
                Victor Wagner <vi...@wagner.pp.ru>


diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index ad216dd..87bc4ad 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/doc/src/sgml/pltcl.sgml
@@ -901,6 +901,79 @@ if {[catch { spi_exec $sql_command }]} {
      is a global variable.)
     </para>
    </sect1>
+   <sect1 id="pltcl-subtransaction">
+   <title>Explicit Subtransactions</title>
+  <para>
+   Recovering from errors caused by database access as described in
+   <xref linkend="pltcl-error-handling"> can lead to an undesirable
+   situation where some operations succeed before one of them fails,
+   and after recovering from that error the data is left in an
+   inconsistent state.  PL/Tcl offers a solution to this problem in
+   the form of explicit subtransactions.
+  </para>
+   <para>
+    Consider a function that implements a transfer between two
+    accounts:
+<programlisting>
+CREATE FUNCTION transfer_funds() RETURNS void AS $$
+if [catch {
+    spi_exec "UPDATE accounts SET balance = balance - 100 WHERE account_name = 'joe'"
+    spi_exec "UPDATE accounts SET balance = balance + 100 WHERE account_name = 'mary'"
+} errormsg] {
+    set result [format "error transferring funds: %s" $errormsg ]
+} else {
+    set result "funds transferred correctly"
+}
+set plan [spi_prepare "INSERT INTO operations (result) VALUES ($1)"]
+spi_execp -count 1 $plan, [list $result)
+$$ LANGUAGE pltclu;
+</programlisting>
+    If the second <literal>UPDATE</literal> statement results in an
+    exception being raised, this function will report the error, but
+    the result of the first <literal>UPDATE</literal> will
+    nevertheless be committed.  In other words, the funds will be
+    withdrawn from Joe's account, but will not be transferred to
+    Mary's account.
+   </para>
+   <para>
+    To avoid such issues, you can wrap your
+    <literal>spi_exec</literal> calls in an explicit
+    subtransaction.  The PL/Tcl provides a
+    commmand <literal>subtransaction</literal> to manage explicit
+	subtransactions.
+     Using explicit subtransactions
+    we can rewrite our function as:
+<programlisting>
+CREATE FUNCTION transfer_funds2() RETURNS void AS $$
+if [catch {
+	subtransaction {
+        spi_exec "UPDATE accounts SET balance = balance - 100 WHERE account_name = 'joe'"
+        spi_exec "UPDATE accounts SET balance = balance + 100 WHERE account_name = 'mary'"
+	    }
+	} errormsg] {
+		set result [format "error transferring funds: %s" $errormsg]
+	} else {
+       set result "funds transferred correctly"
+	}
+    set plan  [spi_prepare "INSERT INTO operations (result) VALUES ($1)"]
+    spi_execp $plan, [list $result]
+$$ LANGUAGE pltclu;
+</programlisting>
+    Note that the use of <literal>catch</literal> is still
+    required.  Otherwise the exception would propagate to the top of
+    the  stack and would cause the whole function to abort with
+    a <productname>PostgreSQL</productname> error, so that the
+    <literal>operations</literal> table would not have any row
+    inserted into it.  The <literal>subtransaction</literal> command does not
+    trap errors, it only assures that all database operations executed
+    inside its scope will be atomically committed or rolled back.  A
+    rollback of the subtransaction block occurs on any kind of
+    exception exit, not only ones caused by errors originating from
+    database access.  A regular Tcl exception raised inside an
+    explicit subtransaction block would also cause the subtransaction
+    to be rolled back.
+   </para>
+  </sect1>
 
    <sect1 id="pltcl-config">
     <title>PL/Tcl Configuration</title>
diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile
index 1096c4f..b6b6b19 100644
--- a/src/pl/tcl/Makefile
+++ b/src/pl/tcl/Makefile
@@ -28,7 +28,7 @@ DATA = pltcl.control pltcl--1.0.sql pltcl--unpackaged--1.0.sql \
        pltclu.control pltclu--1.0.sql pltclu--unpackaged--1.0.sql
 
 REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=pltcl
-REGRESS = pltcl_setup pltcl_queries pltcl_start_proc pltcl_unicode
+REGRESS = pltcl_setup pltcl_queries pltcl_start_proc pltcl_unicode pltcl_subxact
 
 # Tcl on win32 ships with import libraries only for Microsoft Visual C++,
 # which are not compatible with mingw gcc. Therefore we need to build a
diff --git a/src/pl/tcl/expected/pltcl_subxact.out b/src/pl/tcl/expected/pltcl_subxact.out
new file mode 100644
index 0000000..5d984f1
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_subxact.out
@@ -0,0 +1,171 @@
+--
+-- Test explicit subtransactions
+--
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+-- test subtransaction successfully commited
+CREATE FUNCTION subtransaction_ctx_success() RETURNS text
+AS $$
+	spi_exec "INSERT INTO subtransaction_tbl VALUES(1)"
+    subtransaction {
+		spi_exec "INSERT INTO subtransaction_tbl VALUES(2)"
+	}
+$$ LANGUAGE pltcl;
+BEGIN;
+INSERT INTO subtransaction_tbl VALUES(0);
+SELECT subtransaction_ctx_success();
+ subtransaction_ctx_success 
+----------------------------
+ 1
+(1 row)
+
+COMMIT;
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 0
+ 1
+ 2
+(3 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Test table to see if transactions get properly rolled back
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS text
+AS $$
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if {$1 == "SPI"} {
+        spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')"
+    } elseif { $1 == "Tcl"} {
+	    elog ERROR "Tcl error"
+    }
+}
+$$ LANGUAGE pltcl;
+SELECT subtransaction_ctx_test();
+ subtransaction_ctx_test 
+-------------------------
+ 
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 1
+ 2
+(2 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_ctx_test('SPI');
+ERROR:  invalid input syntax for integer: "oops"
+CONTEXT:  invalid input syntax for integer: "oops"
+    while executing
+"spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')""
+    invoked from within
+"subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if {$1 == "SPI"..."
+    (procedure "__PLTcl_proc_16503" line 3)
+    invoked from within
+"__PLTcl_proc_16503 SPI"
+in PL/Tcl function "subtransaction_ctx_test"
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_ctx_test('Tcl');
+ERROR:  Tcl error
+CONTEXT:  Tcl error
+    while executing
+"elog ERROR "Tcl error""
+    invoked from within
+"subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if {$1 == "SPI"..."
+    (procedure "__PLTcl_proc_16503" line 3)
+    invoked from within
+"__PLTcl_proc_16503 Tcl"
+in PL/Tcl function "subtransaction_ctx_test"
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Nested subtransactions
+CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text
+AS $$
+elog NOTICE "subtransaction_tested_test got arg '$1'"
+spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if [catch {
+	    subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+		}
+    } errormsg] {
+		if {$1 != "t"} {
+			error $errormsg $::errorInfo $::errorCode
+		}
+        elog NOTICE "Swallowed $errormsg"
+	}
+}
+return "ok"
+$$ LANGUAGE pltcl;
+SELECT subtransaction_nested_test();
+NOTICE:  subtransaction_tested_test got arg 'f'
+ERROR:  syntax error at or near "error"
+CONTEXT:  syntax error at or near "error"
+    while executing
+"spi_exec "error""
+    invoked from within
+"subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+		}"
+    invoked from within
+"if [catch {
+	    subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+		}
+    } errormsg] {
+..."
+    invoked from within
+"subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if [catch {
+	    subtransaction {
+            spi_exec "INSERT INTO subt..."
+    (procedure "__PLTcl_proc_16507" line 5)
+    invoked from within
+"__PLTcl_proc_16507 f"
+in PL/Tcl function "subtransaction_nested_test"
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_nested_test('t');
+NOTICE:  subtransaction_tested_test got arg 't'
+NOTICE:  Swallowed syntax error at or near "error"
+ subtransaction_nested_test 
+----------------------------
+ ok
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 1
+ 2
+(2 rows)
+
+TRUNCATE subtransaction_tbl;
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 2cf7e66..266d7b9 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -323,6 +323,8 @@ static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp,
 						 pltcl_call_state *call_state);
 static void pltcl_init_tuple_store(pltcl_call_state *call_state);
 
+static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
+	int objc, Tcl_Obj *const objv[]);
 
 /*
  * Hack to override Tcl's builtin Notifier subsystem.  This prevents the
@@ -516,7 +518,8 @@ pltcl_init_interp(pltcl_interp_desc *interp_desc, Oid prolang, bool pltrusted)
 						 pltcl_SPI_execute_plan, NULL, NULL);
 	Tcl_CreateObjCommand(interp, "spi_lastoid",
 						 pltcl_SPI_lastoid, NULL, NULL);
-
+	Tcl_CreateObjCommand(interp, "subtransaction",
+						 pltcl_subtransaction, NULL,NULL);
 	/************************************************************
 	 * Call the appropriate start_proc, if there is one.
 	 *
@@ -3114,3 +3117,44 @@ pltcl_init_tuple_store(pltcl_call_state *call_state)
 	CurrentResourceOwner = oldowner;
 	MemoryContextSwitchTo(oldcxt);
 }
+
+/*
+ * pltcl_subtransaction - implements tcl level subtransaction block
+ * Called with exactly one argument - piece of Tcl Code, and executes
+ * this code inside subtransaction.
+ * Rolls subtransaction back if Tcl_EvalEx returns TCL_ERROR
+ */
+static int
+pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
+					 int objc, Tcl_Obj *const objv[])
+{
+	/* Save resource owner and memory context in the local vars */
+	ResourceOwner oldowner = CurrentResourceOwner;
+	MemoryContext oldcontext = CurrentMemoryContext;
+	int retcode;
+	if (objc != 2)
+	{
+		Tcl_WrongNumArgs(interp,1,objv,"command");
+		return TCL_ERROR;
+	}
+
+	BeginInternalSubTransaction(NULL);
+
+	retcode = Tcl_EvalObjEx(interp, objv[1],0);
+
+	if (retcode == TCL_ERROR)
+	{
+		/* Roollback the subtransaction */
+		RollbackAndReleaseCurrentSubTransaction();
+	}
+	else
+	{
+		/* Commit the subtransaction */
+		ReleaseCurrentSubTransaction();
+	}
+	/* Restore resource owner and memory context
+	  In case they were changed inside subtransaction */
+	CurrentResourceOwner = oldowner;
+	MemoryContextSwitchTo(oldcontext);
+	return retcode;
+}
diff --git a/src/pl/tcl/sql/pltcl_subxact.sql b/src/pl/tcl/sql/pltcl_subxact.sql
new file mode 100644
index 0000000..b243083
--- /dev/null
+++ b/src/pl/tcl/sql/pltcl_subxact.sql
@@ -0,0 +1,81 @@
+--
+-- Test explicit subtransactions
+--
+
+
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+
+-- test subtransaction successfully commited
+
+CREATE FUNCTION subtransaction_ctx_success() RETURNS text
+AS $$
+	spi_exec "INSERT INTO subtransaction_tbl VALUES(1)"
+    subtransaction {
+		spi_exec "INSERT INTO subtransaction_tbl VALUES(2)"
+	}
+$$ LANGUAGE pltcl;
+
+BEGIN;
+INSERT INTO subtransaction_tbl VALUES(0);
+SELECT subtransaction_ctx_success();
+COMMIT;
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+-- Test table to see if transactions get properly rolled back
+
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS text
+AS $$
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if {$1 == "SPI"} {
+        spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')"
+    } elseif { $1 == "Tcl"} {
+	    elog ERROR "Tcl error"
+    }
+}
+$$ LANGUAGE pltcl;
+
+SELECT subtransaction_ctx_test();
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_ctx_test('SPI');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_ctx_test('Tcl');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+-- Nested subtransactions
+
+CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text
+AS $$
+elog NOTICE "subtransaction_tested_test got arg '$1'"
+spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if [catch {
+	    subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+		}
+    } errormsg] {
+		if {$1 != "t"} {
+			error $errormsg $::errorInfo $::errorCode
+		}
+        elog NOTICE "Swallowed $errormsg"
+	}
+}
+return "ok"
+$$ LANGUAGE pltcl;
+
+SELECT subtransaction_nested_test();
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+SELECT subtransaction_nested_test('t');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
-- 
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers

Reply via email to