aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/pl/tcl/Makefile2
-rw-r--r--src/pl/tcl/expected/pltcl_subxact.out143
-rw-r--r--src/pl/tcl/pltcl.c53
-rw-r--r--src/pl/tcl/sql/pltcl_subxact.sql95
4 files changed, 292 insertions, 1 deletions
diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile
index 1096c4faf04..0275c125b12 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_subxact pltcl_unicode
# 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 00000000000..4393f4acf69
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_subxact.out
@@ -0,0 +1,143 @@
+--
+-- Test explicit subtransactions
+--
+CREATE TABLE subtransaction_tbl (
+ i integer
+);
+--
+-- We use this wrapper to catch errors and return errormsg only,
+-- because values of $::errorinfo variable contain procedure name which
+-- includes OID, so it's not stable
+--
+CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text
+AS $$
+ if [catch {spi_exec $1} msg] {
+ return "ERROR: $msg"
+ } else {
+ return "SUCCESS: $msg"
+ }
+$$ LANGUAGE pltcl;
+-- Test subtransaction successfully committed
+CREATE FUNCTION subtransaction_ctx_success() RETURNS void
+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 row)
+
+COMMIT;
+SELECT * FROM subtransaction_tbl;
+ i
+---
+ 0
+ 1
+ 2
+(3 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Test subtransaction rollback
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS void
+AS $$
+ spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+ subtransaction {
+ 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 pltcl_wrapper('SELECT subtransaction_ctx_test()');
+ pltcl_wrapper
+---------------
+ SUCCESS: 1
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i
+---
+ 1
+ 2
+(2 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''SPI'')');
+ pltcl_wrapper
+-------------------------------------------------
+ ERROR: invalid input syntax for integer: "oops"
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''Tcl'')');
+ pltcl_wrapper
+------------------
+ ERROR: Tcl error
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Nested subtransactions
+CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text
+AS $$
+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 pltcl_wrapper('SELECT subtransaction_nested_test()');
+ pltcl_wrapper
+----------------------------------------
+ ERROR: syntax error at or near "error"
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_nested_test(''t'')');
+NOTICE: Swallowed syntax error at or near "error"
+ pltcl_wrapper
+---------------
+ SUCCESS: 1
+(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 2cf7e6619b0..b8fcf0673d3 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -306,6 +306,8 @@ static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
static void pltcl_subtrans_begin(MemoryContext oldcontext,
ResourceOwner oldowner);
@@ -516,6 +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.
@@ -2851,6 +2855,55 @@ pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
/**********************************************************************
+ * pltcl_subtransaction() - Execute some Tcl code in a subtransaction
+ *
+ * The subtransaction is aborted if the Tcl code fragment returns TCL_ERROR,
+ * otherwise it's subcommitted.
+ **********************************************************************/
+static int
+pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[])
+{
+ MemoryContext oldcontext = CurrentMemoryContext;
+ ResourceOwner oldowner = CurrentResourceOwner;
+ int retcode;
+
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "command");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Note: we don't use pltcl_subtrans_begin and friends here because we
+ * don't want the error handling in pltcl_subtrans_abort. But otherwise
+ * the processing should be about the same as in those functions.
+ */
+ BeginInternalSubTransaction(NULL);
+ MemoryContextSwitchTo(oldcontext);
+
+ retcode = Tcl_EvalObjEx(interp, objv[1], 0);
+
+ if (retcode == TCL_ERROR)
+ {
+ /* Rollback the subtransaction */
+ RollbackAndReleaseCurrentSubTransaction();
+ }
+ else
+ {
+ /* Commit the subtransaction */
+ ReleaseCurrentSubTransaction();
+ }
+
+ /* In either case, restore previous memory context and resource owner */
+ MemoryContextSwitchTo(oldcontext);
+ CurrentResourceOwner = oldowner;
+
+ return retcode;
+}
+
+
+/**********************************************************************
* pltcl_set_tuple_values() - Set variables for all attributes
* of a given tuple
*
diff --git a/src/pl/tcl/sql/pltcl_subxact.sql b/src/pl/tcl/sql/pltcl_subxact.sql
new file mode 100644
index 00000000000..0625736ea4b
--- /dev/null
+++ b/src/pl/tcl/sql/pltcl_subxact.sql
@@ -0,0 +1,95 @@
+--
+-- Test explicit subtransactions
+--
+
+CREATE TABLE subtransaction_tbl (
+ i integer
+);
+
+--
+-- We use this wrapper to catch errors and return errormsg only,
+-- because values of $::errorinfo variable contain procedure name which
+-- includes OID, so it's not stable
+--
+CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text
+AS $$
+ if [catch {spi_exec $1} msg] {
+ return "ERROR: $msg"
+ } else {
+ return "SUCCESS: $msg"
+ }
+$$ LANGUAGE pltcl;
+
+-- Test subtransaction successfully committed
+
+CREATE FUNCTION subtransaction_ctx_success() RETURNS void
+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 subtransaction rollback
+
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS void
+AS $$
+ spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+ subtransaction {
+ 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 pltcl_wrapper('SELECT subtransaction_ctx_test()');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''SPI'')');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+SELECT pltcl_wrapper('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 $$
+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 pltcl_wrapper('SELECT subtransaction_nested_test()');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+SELECT pltcl_wrapper('SELECT subtransaction_nested_test(''t'')');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-05 11:47:40 +0000