diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 7893d263775466945fcf638b4dd1a94316a03d78..7642f50ca45b5c12b76c8dafff0aa7ef70dca82f 100644
--- a/doc/src/sgml/plperl.sgml
+++ b/doc/src/sgml/plperl.sgml
@@ -1,5 +1,5 @@
<!--
-$PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.31 2004/11/19 23:22:54 tgl Exp $
+$PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.32 2004/11/21 21:17:01 tgl Exp $
-->
<chapter id="plperl">
@@ -219,9 +219,13 @@ $nrows = $rv->{processed};
Emit a log or error message. Possible levels are
<literal>DEBUG</>, <literal>LOG</>, <literal>INFO</>,
<literal>NOTICE</>, <literal>WARNING</>, and <literal>ERROR</>.
- <literal>ERROR</> raises an error condition: further execution
- of the function is abandoned, and the current transaction is
- aborted.
+ <literal>ERROR</>
+ raises an error condition; if this is not trapped by the surrounding
+ Perl code, the error propagates out to the calling query, causing
+ the current transaction or subtransaction to be aborted. This
+ is effectively the same as the Perl <literal>die</> command.
+ The other levels simply report the message to the system log
+ and/or client.
</para>
</listitem>
</varlistentry>
diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index 09f8f82eaa4d2a261d5602c67362dd198f2a78c0..b454c6a45f8afd21a23c67efc03234d7e85ce541 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/doc/src/sgml/pltcl.sgml
@@ -1,5 +1,5 @@
<!--
-$PostgreSQL: pgsql/doc/src/sgml/pltcl.sgml,v 2.31 2004/09/20 22:48:25 tgl Exp $
+$PostgreSQL: pgsql/doc/src/sgml/pltcl.sgml,v 2.32 2004/11/21 21:17:02 tgl Exp $
-->
<chapter id="pltcl">
@@ -449,17 +449,19 @@ SELECT 'doesn''t' AS ret
<term><function>elog</> <replaceable>level</replaceable> <replaceable>msg</replaceable></term>
<listitem>
<para>
- Emits a log or error message. Possible levels are
- <literal>DEBUG</>, <literal>LOG</>, <literal>INFO</>,
- <literal>NOTICE</>, <literal>WARNING</>, <literal>ERROR</>, and
- <literal>FATAL</>. Most simply emit the given message just like
- the <literal>elog</> C function. <literal>ERROR</>
- raises an error condition: further execution of the function is
- abandoned, and the current transaction is aborted.
- <literal>FATAL</> aborts the transaction and causes the current
- session to shut down. (There is probably no good reason to use
- this error level in PL/Tcl functions, but it's provided for
- completeness.)
+ Emits a log or error message. Possible levels are
+ <literal>DEBUG</>, <literal>LOG</>, <literal>INFO</>,
+ <literal>NOTICE</>, <literal>WARNING</>, <literal>ERROR</>, and
+ <literal>FATAL</>. Most simply emit the given message just like
+ the <literal>elog</> C function. <literal>ERROR</>
+ raises an error condition; if this is not trapped by the surrounding
+ Tcl code, the error propagates out to the calling query, causing
+ the current transaction or subtransaction to be aborted. This
+ is effectively the same as the Tcl <literal>error</> command.
+ <literal>FATAL</> aborts the transaction and causes the current
+ session to shut down. (There is probably no good reason to use
+ this error level in PL/Tcl functions, but it's provided for
+ completeness.)
</para>
</listitem>
</varlistentry>
diff --git a/doc/src/sgml/release.sgml b/doc/src/sgml/release.sgml
index e0d58a0ee0a602dbdf543625c454327a3689590c..39f6f763c9bdecfec00970377c1e04c88f18b2b3 100644
--- a/doc/src/sgml/release.sgml
+++ b/doc/src/sgml/release.sgml
@@ -1,5 +1,5 @@
<!--
-$PostgreSQL: pgsql/doc/src/sgml/release.sgml,v 1.309 2004/11/20 21:44:24 tgl Exp $
+$PostgreSQL: pgsql/doc/src/sgml/release.sgml,v 1.310 2004/11/21 21:17:02 tgl Exp $
-->
<appendix id="release">
@@ -1686,6 +1686,15 @@ $PostgreSQL: pgsql/doc/src/sgml/release.sgml,v 1.309 2004/11/20 21:44:24 tgl Exp
</para>
</listitem>
+ <listitem>
+ <para>
+ In PL/Tcl, SPI commands are now run in subtransactions. If an error
+ occurs, the subtransaction is cleaned up and the error is reported
+ as an ordinary Tcl error, which can be trapped with <literal>catch</>.
+ Formerly, it was not possible to catch such errors.
+ </para>
+ </listitem>
+
</itemizedlist>
</sect3>
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index d2746641852e39fd20cd148980a5f4ac8bdc9cfd..36665cff271f1697605d0ef0419c4c553e513f61 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
* ENHANCEMENTS, OR MODIFICATIONS.
*
* IDENTIFICATION
- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.59 2004/11/20 19:07:40 tgl Exp $
+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.60 2004/11/21 21:17:03 tgl Exp $
*
**********************************************************************/
@@ -1593,20 +1593,79 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
}
+/*
+ * Implementation of spi_exec_query() Perl function
+ */
HV *
plperl_spi_exec(char *query, int limit)
{
HV *ret_hv;
- int spi_rv;
- spi_rv = SPI_execute(query, plperl_current_prodesc->fn_readonly, limit);
- ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed, spi_rv);
+ /*
+ * Execute the query inside a sub-transaction, so we can cope with
+ * errors sanely
+ */
+ MemoryContext oldcontext = CurrentMemoryContext;
+ ResourceOwner oldowner = CurrentResourceOwner;
+
+ BeginInternalSubTransaction(NULL);
+ /* Want to run inside function's memory context */
+ MemoryContextSwitchTo(oldcontext);
+
+ PG_TRY();
+ {
+ int spi_rv;
+
+ spi_rv = SPI_execute(query, plperl_current_prodesc->fn_readonly,
+ limit);
+ ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
+ spi_rv);
+
+ /* Commit the inner transaction, return to outer xact context */
+ ReleaseCurrentSubTransaction();
+ MemoryContextSwitchTo(oldcontext);
+ CurrentResourceOwner = oldowner;
+ /*
+ * AtEOSubXact_SPI() should not have popped any SPI context,
+ * but just in case it did, make sure we remain connected.
+ */
+ SPI_restore_connection();
+ }
+ PG_CATCH();
+ {
+ ErrorData *edata;
+
+ /* Save error info */
+ MemoryContextSwitchTo(oldcontext);
+ edata = CopyErrorData();
+ FlushErrorState();
+
+ /* Abort the inner transaction */
+ RollbackAndReleaseCurrentSubTransaction();
+ MemoryContextSwitchTo(oldcontext);
+ CurrentResourceOwner = oldowner;
+
+ /*
+ * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+ * it will have left us in a disconnected state. We need this
+ * hack to return to connected state.
+ */
+ SPI_restore_connection();
+
+ /* Punt the error to Perl */
+ croak("%s", edata->message);
+
+ /* Can't get here, but keep compiler quiet */
+ return NULL;
+ }
+ PG_END_TRY();
return ret_hv;
}
static HV *
-plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status)
+plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed,
+ int status)
{
HV *result;
@@ -1619,21 +1678,18 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int stat
if (status == SPI_OK_SELECT)
{
- if (processed)
- {
- AV *rows;
- HV *row;
- int i;
+ AV *rows;
+ HV *row;
+ int i;
- rows = newAV();
- for (i = 0; i < processed; i++)
- {
- row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
- av_push(rows, newRV_noinc((SV *)row));
- }
- hv_store(result, "rows", strlen("rows"),
- newRV_noinc((SV *) rows), 0);
+ rows = newAV();
+ for (i = 0; i < processed; i++)
+ {
+ row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
+ av_push(rows, newRV_noinc((SV *)row));
}
+ hv_store(result, "rows", strlen("rows"),
+ newRV_noinc((SV *) rows), 0);
}
SPI_freetuptable(tuptable);
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index da1cee09adf6d7fe0af49b2475f52f42c6f9a619..a95344759a313653e974de1de5172a34f5a75e5a 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -31,7 +31,7 @@
* ENHANCEMENTS, OR MODIFICATIONS.
*
* IDENTIFICATION
- * $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.93 2004/09/14 03:21:27 tgl Exp $
+ * $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.94 2004/11/21 21:17:05 tgl Exp $
*
**********************************************************************/
@@ -147,19 +147,6 @@ static Tcl_HashTable *pltcl_safe_query_hash = NULL;
static FunctionCallInfo pltcl_current_fcinfo = NULL;
static pltcl_proc_desc *pltcl_current_prodesc = NULL;
-/*
- * When a callback from Tcl into PG incurs an error, we temporarily store
- * the error information here, and return TCL_ERROR to the Tcl interpreter.
- * Any further callback attempts immediately fail, and when the Tcl interpreter
- * returns to the calling function, we re-throw the error (even if Tcl
- * thinks it trapped the error and doesn't return TCL_ERROR). Eventually
- * this ought to be improved to let Tcl code really truly trap the error,
- * but that's more of a change from the pre-8.0 semantics than I have time
- * for now --- it will only be possible if the callback query is executed
- * inside a subtransaction.
- */
-static ErrorData *pltcl_error_in_progress = NULL;
-
/**********************************************************************
* Forward declarations
**********************************************************************/
@@ -189,6 +176,12 @@ static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
+static int pltcl_process_SPI_result(Tcl_Interp *interp,
+ CONST84 char *arrayname,
+ CONST84 char *loop_body,
+ int spi_rc,
+ SPITupleTable *tuptable,
+ int ntuples);
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
@@ -592,28 +585,16 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
Tcl_DStringFree(&tcl_cmd);
/************************************************************
- * If there was an error in a PG callback, propagate that
- * no matter what Tcl claims about its success.
- ************************************************************/
- if (pltcl_error_in_progress)
- {
- ErrorData *edata = pltcl_error_in_progress;
-
- pltcl_error_in_progress = NULL;
- ReThrowError(edata);
- }
-
- /************************************************************
- * Check for errors reported by Tcl itself.
+ * Check for errors reported by Tcl.
************************************************************/
if (tcl_rc != TCL_OK)
{
UTF_BEGIN;
ereport(ERROR,
- (errmsg("pltcl: %s", interp->result),
- errdetail("%s",
- UTF_U2E(Tcl_GetVar(interp, "errorInfo",
- TCL_GLOBAL_ONLY)))));
+ (errmsg("%s", interp->result),
+ errcontext("%s",
+ UTF_U2E(Tcl_GetVar(interp, "errorInfo",
+ TCL_GLOBAL_ONLY)))));
UTF_END;
}
@@ -820,28 +801,16 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
Tcl_DStringFree(&tcl_cmd);
/************************************************************
- * If there was an error in a PG callback, propagate that
- * no matter what Tcl claims about its success.
- ************************************************************/
- if (pltcl_error_in_progress)
- {
- ErrorData *edata = pltcl_error_in_progress;
-
- pltcl_error_in_progress = NULL;
- ReThrowError(edata);
- }
-
- /************************************************************
- * Check for errors reported by Tcl itself.
+ * Check for errors reported by Tcl.
************************************************************/
if (tcl_rc != TCL_OK)
{
UTF_BEGIN;
ereport(ERROR,
- (errmsg("pltcl: %s", interp->result),
- errdetail("%s",
- UTF_U2E(Tcl_GetVar(interp, "errorInfo",
- TCL_GLOBAL_ONLY)))));
+ (errmsg("%s", interp->result),
+ errcontext("%s",
+ UTF_U2E(Tcl_GetVar(interp, "errorInfo",
+ TCL_GLOBAL_ONLY)))));
UTF_END;
}
@@ -1312,15 +1281,6 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
volatile int level;
MemoryContext oldcontext;
- /************************************************************
- * Suppress messages if an error is already declared
- ************************************************************/
- if (pltcl_error_in_progress)
- {
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
- return TCL_ERROR;
- }
-
if (argc != 3)
{
Tcl_SetResult(interp, "syntax error - 'elog level msg'",
@@ -1350,8 +1310,9 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
}
/************************************************************
- * If elog() throws an error, catch and save it, then return
- * error indication to Tcl interpreter.
+ * If elog() throws an error, catch it and return the error to the
+ * Tcl interpreter. Note we are assuming that elog() can't have any
+ * internal failures that are so bad as to require a transaction abort.
************************************************************/
oldcontext = CurrentMemoryContext;
PG_TRY();
@@ -1362,9 +1323,17 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
}
PG_CATCH();
{
+ ErrorData *edata;
+
+ /* Must reset elog.c's state */
MemoryContextSwitchTo(oldcontext);
- pltcl_error_in_progress = CopyErrorData();
+ edata = CopyErrorData();
FlushErrorState();
+
+ /* Pass the error message to Tcl */
+ Tcl_SetResult(interp, edata->message, TCL_VOLATILE);
+ FreeErrorData(edata);
+
return TCL_ERROR;
}
PG_END_TRY();
@@ -1522,6 +1491,83 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
}
+/*----------
+ * Support for running SPI operations inside subtransactions
+ *
+ * Intended usage pattern is:
+ *
+ * MemoryContext oldcontext = CurrentMemoryContext;
+ * ResourceOwner oldowner = CurrentResourceOwner;
+ *
+ * ...
+ * pltcl_subtrans_begin(oldcontext, oldowner);
+ * PG_TRY();
+ * {
+ * do something risky;
+ * pltcl_subtrans_commit(oldcontext, oldowner);
+ * }
+ * PG_CATCH();
+ * {
+ * pltcl_subtrans_abort(interp, oldcontext, oldowner);
+ * return TCL_ERROR;
+ * }
+ * PG_END_TRY();
+ * return TCL_OK;
+ *----------
+ */
+static void
+pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner)
+{
+ BeginInternalSubTransaction(NULL);
+
+ /* Want to run inside function's memory context */
+ MemoryContextSwitchTo(oldcontext);
+}
+
+static void
+pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner)
+{
+ /* Commit the inner transaction, return to outer xact context */
+ ReleaseCurrentSubTransaction();
+ MemoryContextSwitchTo(oldcontext);
+ CurrentResourceOwner = oldowner;
+
+ /*
+ * AtEOSubXact_SPI() should not have popped any SPI context,
+ * but just in case it did, make sure we remain connected.
+ */
+ SPI_restore_connection();
+}
+
+static void
+pltcl_subtrans_abort(Tcl_Interp *interp,
+ MemoryContext oldcontext, ResourceOwner oldowner)
+{
+ ErrorData *edata;
+
+ /* Save error info */
+ MemoryContextSwitchTo(oldcontext);
+ edata = CopyErrorData();
+ FlushErrorState();
+
+ /* Abort the inner transaction */
+ RollbackAndReleaseCurrentSubTransaction();
+ MemoryContextSwitchTo(oldcontext);
+ CurrentResourceOwner = oldowner;
+
+ /*
+ * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+ * it will have left us in a disconnected state. We need this
+ * hack to return to connected state.
+ */
+ SPI_restore_connection();
+
+ /* Pass the error message to Tcl */
+ Tcl_SetResult(interp, edata->message, TCL_VOLATILE);
+ FreeErrorData(edata);
+}
+
+
/**********************************************************************
* pltcl_SPI_execute() - The builtin SPI_execute command
* for the Tcl interpreter
@@ -1530,35 +1576,22 @@ static int
pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
- volatile int my_rc;
+ int my_rc;
int spi_rc;
- char buf[64];
+ int query_idx;
+ int i;
int count = 0;
CONST84 char *volatile arrayname = NULL;
- volatile int query_idx;
- int i;
- int loop_rc;
- int ntuples;
- HeapTuple *volatile tuples;
- volatile TupleDesc tupdesc = NULL;
- SPITupleTable *tuptable;
- MemoryContext oldcontext;
+ CONST84 char *volatile loop_body = NULL;
+ MemoryContext oldcontext = CurrentMemoryContext;
+ ResourceOwner oldowner = CurrentResourceOwner;
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
/************************************************************
- * Don't do anything if we are already in error mode
- ************************************************************/
- if (pltcl_error_in_progress)
- {
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
- return TCL_ERROR;
- }
-
- /************************************************************
- * Check the call syntax and get the count option
+ * Check the call syntax and get the options
************************************************************/
if (argc < 2)
{
@@ -1596,133 +1629,143 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
}
query_idx = i;
- if (query_idx >= argc)
+ if (query_idx >= argc || query_idx + 2 < argc)
{
Tcl_SetResult(interp, usage, TCL_VOLATILE);
return TCL_ERROR;
}
+ if (query_idx + 1 < argc)
+ loop_body = argv[query_idx + 1];
/************************************************************
- * Execute the query and handle return codes
+ * Execute the query inside a sub-transaction, so we can cope with
+ * errors sanely
************************************************************/
- oldcontext = CurrentMemoryContext;
+
+ pltcl_subtrans_begin(oldcontext, oldowner);
+
PG_TRY();
{
UTF_BEGIN;
spi_rc = SPI_execute(UTF_U2E(argv[query_idx]),
pltcl_current_prodesc->fn_readonly, count);
UTF_END;
+
+ my_rc = pltcl_process_SPI_result(interp,
+ arrayname,
+ loop_body,
+ spi_rc,
+ SPI_tuptable,
+ SPI_processed);
+
+ pltcl_subtrans_commit(oldcontext, oldowner);
}
PG_CATCH();
{
- MemoryContextSwitchTo(oldcontext);
- pltcl_error_in_progress = CopyErrorData();
- FlushErrorState();
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
+ pltcl_subtrans_abort(interp, oldcontext, oldowner);
return TCL_ERROR;
}
PG_END_TRY();
+ return my_rc;
+}
+
+/*
+ * Process the result from SPI_execute or SPI_execute_plan
+ *
+ * Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
+ */
+static int
+pltcl_process_SPI_result(Tcl_Interp *interp,
+ CONST84 char *arrayname,
+ CONST84 char *loop_body,
+ int spi_rc,
+ SPITupleTable *tuptable,
+ int ntuples)
+{
+ int my_rc = TCL_OK;
+ char buf[64];
+ int i;
+ int loop_rc;
+ HeapTuple *tuples;
+ TupleDesc tupdesc;
+
switch (spi_rc)
{
case SPI_OK_UTILITY:
Tcl_SetResult(interp, "0", TCL_VOLATILE);
- SPI_freetuptable(SPI_tuptable);
- return TCL_OK;
+ break;
case SPI_OK_SELINTO:
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
- snprintf(buf, sizeof(buf), "%d", SPI_processed);
+ snprintf(buf, sizeof(buf), "%d", ntuples);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
- SPI_freetuptable(SPI_tuptable);
- return TCL_OK;
-
- case SPI_OK_SELECT:
break;
- default:
- Tcl_AppendResult(interp, "pltcl: SPI_execute failed: ",
- SPI_result_code_string(spi_rc), NULL);
- SPI_freetuptable(SPI_tuptable);
- return TCL_ERROR;
- }
-
- /************************************************************
- * Only SELECT queries fall through to here - process the tuples we got
- ************************************************************/
- ntuples = SPI_processed;
- tuptable = SPI_tuptable;
- if (ntuples > 0)
- {
- tuples = tuptable->vals;
- tupdesc = tuptable->tupdesc;
- }
+ case SPI_OK_SELECT:
+ /*
+ * Process the tuples we got
+ */
+ tuples = tuptable->vals;
+ tupdesc = tuptable->tupdesc;
- my_rc = TCL_OK;
- PG_TRY();
- {
- if (argc == query_idx + 1)
- {
- /************************************************************
- * If there is no loop body given, just set the variables
- * from the first tuple (if any)
- ************************************************************/
- if (ntuples > 0)
- pltcl_set_tuple_values(interp, arrayname, 0,
- tuples[0], tupdesc);
- }
- else
- {
- /************************************************************
- * There is a loop body - process all tuples and evaluate
- * the body on each
- ************************************************************/
- query_idx++;
- for (i = 0; i < ntuples; i++)
+ if (loop_body == NULL)
{
- pltcl_set_tuple_values(interp, arrayname, i,
- tuples[i], tupdesc);
-
- loop_rc = Tcl_Eval(interp, argv[query_idx]);
-
- if (loop_rc == TCL_OK)
- continue;
- if (loop_rc == TCL_CONTINUE)
- continue;
- if (loop_rc == TCL_RETURN)
+ /*
+ * If there is no loop body given, just set the variables
+ * from the first tuple (if any)
+ */
+ if (ntuples > 0)
+ pltcl_set_tuple_values(interp, arrayname, 0,
+ tuples[0], tupdesc);
+ }
+ else
+ {
+ /*
+ * There is a loop body - process all tuples and evaluate
+ * the body on each
+ */
+ for (i = 0; i < ntuples; i++)
{
- my_rc = TCL_RETURN;
+ pltcl_set_tuple_values(interp, arrayname, i,
+ tuples[i], tupdesc);
+
+ loop_rc = Tcl_Eval(interp, loop_body);
+
+ if (loop_rc == TCL_OK)
+ continue;
+ if (loop_rc == TCL_CONTINUE)
+ continue;
+ if (loop_rc == TCL_RETURN)
+ {
+ my_rc = TCL_RETURN;
+ break;
+ }
+ if (loop_rc == TCL_BREAK)
+ break;
+ my_rc = TCL_ERROR;
break;
}
- if (loop_rc == TCL_BREAK)
- break;
- my_rc = TCL_ERROR;
- break;
}
- }
- SPI_freetuptable(tuptable);
- }
- PG_CATCH();
- {
- MemoryContextSwitchTo(oldcontext);
- pltcl_error_in_progress = CopyErrorData();
- FlushErrorState();
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
- return TCL_ERROR;
- }
- PG_END_TRY();
+ if (my_rc == TCL_OK)
+ {
+ snprintf(buf, sizeof(buf), "%d", ntuples);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ break;
- /************************************************************
- * Finally return the number of tuples
- ************************************************************/
- if (my_rc == TCL_OK)
- {
- snprintf(buf, sizeof(buf), "%d", ntuples);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ default:
+ Tcl_AppendResult(interp, "pltcl: SPI_execute failed: ",
+ SPI_result_code_string(spi_rc), NULL);
+ my_rc = TCL_ERROR;
+ break;
}
+
+ SPI_freetuptable(tuptable);
+
return my_rc;
}
@@ -1748,16 +1791,8 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
Tcl_HashEntry *hashent;
int hashnew;
Tcl_HashTable *query_hash;
- MemoryContext oldcontext;
-
- /************************************************************
- * Don't do anything if we are already in error mode
- ************************************************************/
- if (pltcl_error_in_progress)
- {
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
- return TCL_ERROR;
- }
+ MemoryContext oldcontext = CurrentMemoryContext;
+ ResourceOwner oldowner = CurrentResourceOwner;
/************************************************************
* Check the call syntax
@@ -1785,7 +1820,13 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
qdesc->arginfuncs = (FmgrInfo *) malloc(nargs * sizeof(FmgrInfo));
qdesc->argtypioparams = (Oid *) malloc(nargs * sizeof(Oid));
- oldcontext = CurrentMemoryContext;
+ /************************************************************
+ * Execute the prepare inside a sub-transaction, so we can cope with
+ * errors sanely
+ ************************************************************/
+
+ pltcl_subtrans_begin(oldcontext, oldowner);
+
PG_TRY();
{
/************************************************************
@@ -1844,31 +1885,31 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
/* Release the procCxt copy to avoid within-function memory leak */
SPI_freeplan(plan);
- /************************************************************
- * Insert a hashtable entry for the plan and return
- * the key to the caller
- ************************************************************/
- if (interp == pltcl_norm_interp)
- query_hash = pltcl_norm_query_hash;
- else
- query_hash = pltcl_safe_query_hash;
-
+ pltcl_subtrans_commit(oldcontext, oldowner);
}
PG_CATCH();
{
- MemoryContextSwitchTo(oldcontext);
- pltcl_error_in_progress = CopyErrorData();
- FlushErrorState();
+ pltcl_subtrans_abort(interp, oldcontext, oldowner);
+
free(qdesc->argtypes);
free(qdesc->arginfuncs);
free(qdesc->argtypioparams);
free(qdesc);
ckfree((char *) args);
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
+
return TCL_ERROR;
}
PG_END_TRY();
+ /************************************************************
+ * Insert a hashtable entry for the plan and return
+ * the key to the caller
+ ************************************************************/
+ if (interp == pltcl_norm_interp)
+ query_hash = pltcl_norm_query_hash;
+ else
+ query_hash = pltcl_safe_query_hash;
+
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
@@ -1886,41 +1927,27 @@ static int
pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
- volatile int my_rc;
+ int my_rc;
int spi_rc;
- char buf[64];
- volatile int i;
+ int i;
int j;
- int loop_body;
Tcl_HashEntry *hashent;
pltcl_query_desc *qdesc;
- Datum *volatile argvalues = NULL;
const char *volatile nulls = NULL;
CONST84 char *volatile arrayname = NULL;
+ CONST84 char *volatile loop_body = NULL;
int count = 0;
int callnargs;
- CONST84 char **callargs;
- int loop_rc;
- int ntuples;
- HeapTuple *volatile tuples = NULL;
- volatile TupleDesc tupdesc = NULL;
- SPITupleTable *tuptable;
- volatile MemoryContext oldcontext;
+ CONST84 char **callargs = NULL;
+ Datum *argvalues;
+ MemoryContext oldcontext = CurrentMemoryContext;
+ ResourceOwner oldowner = CurrentResourceOwner;
Tcl_HashTable *query_hash;
char *usage = "syntax error - 'SPI_execp "
"?-nulls string? ?-count n? "
"?-array name? query ?args? ?loop body?";
- /************************************************************
- * Don't do anything if we are already in error mode
- ************************************************************/
- if (pltcl_error_in_progress)
- {
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
- return TCL_ERROR;
- }
-
/************************************************************
* Get the options and check syntax
************************************************************/
@@ -1963,7 +1990,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
}
/************************************************************
- * Check minimum call arguments
+ * Get the prepared plan descriptor by its key
************************************************************/
if (i >= argc)
{
@@ -1971,21 +1998,19 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
return TCL_ERROR;
}
- /************************************************************
- * Get the prepared plan descriptor by its key
- ************************************************************/
if (interp == pltcl_norm_interp)
query_hash = pltcl_norm_query_hash;
else
query_hash = pltcl_safe_query_hash;
- hashent = Tcl_FindHashEntry(query_hash, argv[i++]);
+ hashent = Tcl_FindHashEntry(query_hash, argv[i]);
if (hashent == NULL)
{
- Tcl_AppendResult(interp, "invalid queryid '", argv[--i], "'", NULL);
+ Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL);
return TCL_ERROR;
}
qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
+ i++;
/************************************************************
* If a nulls string is given, check for correct length
@@ -2030,178 +2055,86 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
ckfree((char *) callargs);
return TCL_ERROR;
}
-
- /************************************************************
- * Setup the value array for SPI_execute_plan() using
- * the type specific input functions
- ************************************************************/
- oldcontext = CurrentMemoryContext;
- PG_TRY();
- {
- argvalues = (Datum *) palloc(callnargs * sizeof(Datum));
-
- for (j = 0; j < callnargs; j++)
- {
- if (nulls && nulls[j] == 'n')
- {
- /* don't try to convert the input for a null */
- argvalues[j] = (Datum) 0;
- }
- else
- {
- UTF_BEGIN;
- argvalues[j] =
- FunctionCall3(&qdesc->arginfuncs[j],
- CStringGetDatum(UTF_U2E(callargs[j])),
- ObjectIdGetDatum(qdesc->argtypioparams[j]),
- Int32GetDatum(-1));
- UTF_END;
- }
- }
- }
- PG_CATCH();
- {
- ckfree((char *) callargs);
- MemoryContextSwitchTo(oldcontext);
- pltcl_error_in_progress = CopyErrorData();
- FlushErrorState();
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
- return TCL_ERROR;
- }
- PG_END_TRY();
-
- ckfree((char *) callargs);
}
else
callnargs = 0;
/************************************************************
- * Remember the index of the last processed call
- * argument - a loop body for SELECT might follow
+ * Get loop body if present
************************************************************/
- loop_body = i;
+ if (i < argc)
+ loop_body = argv[i++];
- /************************************************************
- * Execute the plan
- ************************************************************/
- oldcontext = CurrentMemoryContext;
- PG_TRY();
+ if (i != argc)
{
- spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
- pltcl_current_prodesc->fn_readonly, count);
- }
- PG_CATCH();
- {
- MemoryContextSwitchTo(oldcontext);
- pltcl_error_in_progress = CopyErrorData();
- FlushErrorState();
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
+ Tcl_SetResult(interp, usage, TCL_VOLATILE);
return TCL_ERROR;
}
- PG_END_TRY();
/************************************************************
- * Check the return code from SPI_execute_plan()
+ * Execute the plan inside a sub-transaction, so we can cope with
+ * errors sanely
************************************************************/
- switch (spi_rc)
- {
- case SPI_OK_UTILITY:
- Tcl_SetResult(interp, "0", TCL_VOLATILE);
- SPI_freetuptable(SPI_tuptable);
- return TCL_OK;
-
- case SPI_OK_SELINTO:
- case SPI_OK_INSERT:
- case SPI_OK_DELETE:
- case SPI_OK_UPDATE:
- snprintf(buf, sizeof(buf), "%d", SPI_processed);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- SPI_freetuptable(SPI_tuptable);
- return TCL_OK;
- case SPI_OK_SELECT:
- break;
+ pltcl_subtrans_begin(oldcontext, oldowner);
- default:
- Tcl_AppendResult(interp, "pltcl: SPI_execute_plan failed: ",
- SPI_result_code_string(spi_rc), NULL);
- SPI_freetuptable(SPI_tuptable);
- return TCL_ERROR;
- }
-
- /************************************************************
- * Only SELECT queries fall through to here - process the tuples we got
- ************************************************************/
- ntuples = SPI_processed;
- tuptable = SPI_tuptable;
- if (ntuples > 0)
- {
- tuples = tuptable->vals;
- tupdesc = tuptable->tupdesc;
- }
-
- my_rc = TCL_OK;
PG_TRY();
{
- if (loop_body >= argc)
- {
- /************************************************************
- * If there is no loop body given, just set the variables
- * from the first tuple (if any)
- ************************************************************/
- if (ntuples > 0)
- pltcl_set_tuple_values(interp, arrayname, 0,
- tuples[0], tupdesc);
- }
- else
+ /************************************************************
+ * Setup the value array for SPI_execute_plan() using
+ * the type specific input functions
+ ************************************************************/
+ argvalues = (Datum *) palloc(callnargs * sizeof(Datum));
+
+ for (j = 0; j < callnargs; j++)
{
- /************************************************************
- * There is a loop body - process all tuples and evaluate
- * the body on each
- ************************************************************/
- for (i = 0; i < ntuples; i++)
+ if (nulls && nulls[j] == 'n')
{
- pltcl_set_tuple_values(interp, arrayname, i,
- tuples[i], tupdesc);
-
- loop_rc = Tcl_Eval(interp, argv[loop_body]);
-
- if (loop_rc == TCL_OK)
- continue;
- if (loop_rc == TCL_CONTINUE)
- continue;
- if (loop_rc == TCL_RETURN)
- {
- my_rc = TCL_RETURN;
- break;
- }
- if (loop_rc == TCL_BREAK)
- break;
- my_rc = TCL_ERROR;
- break;
+ /* don't try to convert the input for a null */
+ argvalues[j] = (Datum) 0;
+ }
+ else
+ {
+ UTF_BEGIN;
+ argvalues[j] =
+ FunctionCall3(&qdesc->arginfuncs[j],
+ CStringGetDatum(UTF_U2E(callargs[j])),
+ ObjectIdGetDatum(qdesc->argtypioparams[j]),
+ Int32GetDatum(-1));
+ UTF_END;
}
}
- SPI_freetuptable(tuptable);
+ if (callargs)
+ ckfree((char *) callargs);
+ callargs = NULL;
+
+ /************************************************************
+ * Execute the plan
+ ************************************************************/
+ spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
+ pltcl_current_prodesc->fn_readonly, count);
+
+ my_rc = pltcl_process_SPI_result(interp,
+ arrayname,
+ loop_body,
+ spi_rc,
+ SPI_tuptable,
+ SPI_processed);
+
+ pltcl_subtrans_commit(oldcontext, oldowner);
}
PG_CATCH();
{
- MemoryContextSwitchTo(oldcontext);
- pltcl_error_in_progress = CopyErrorData();
- FlushErrorState();
- Tcl_SetResult(interp, "Transaction aborted", TCL_VOLATILE);
+ pltcl_subtrans_abort(interp, oldcontext, oldowner);
+
+ if (callargs)
+ ckfree((char *) callargs);
+
return TCL_ERROR;
}
PG_END_TRY();
- /************************************************************
- * Finally return the number of tuples
- ************************************************************/
- if (my_rc == TCL_OK)
- {
- snprintf(buf, sizeof(buf), "%d", ntuples);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- }
return my_rc;
}
diff --git a/src/pl/tcl/test/runtest b/src/pl/tcl/test/runtest
index 32c1433b85e163109a1868d17d3674fc77425946..50b2be07751b0c8f5bafd055f7d479376cfe712d 100755
--- a/src/pl/tcl/test/runtest
+++ b/src/pl/tcl/test/runtest
@@ -6,6 +6,8 @@ export DBNAME
echo "**** Destroy old database $DBNAME ****"
dropdb $DBNAME
+sleep 1
+
echo "**** Create test database $DBNAME ****"
createdb $DBNAME
diff --git a/src/pl/tcl/test/test_queries.sql b/src/pl/tcl/test/test_queries.sql
index 98bc513b4ce81f26c2fc6f9b2aaca5949f6cd479..9cb059ed15f8a946a48d87fa43b4b23e00218bc2 100644
--- a/src/pl/tcl/test/test_queries.sql
+++ b/src/pl/tcl/test/test_queries.sql
@@ -1,3 +1,5 @@
+-- suppress CONTEXT so that function OIDs aren't in output
+\set VERBOSITY terse
insert into T_pkey1 values (1, 'key1-1', 'test key');
insert into T_pkey1 values (1, 'key1-2', 'test key');
diff --git a/src/pl/tcl/test/test_setup.sql b/src/pl/tcl/test/test_setup.sql
index 568a2b3aeb0cced0674d6d5eb985c78b88cf5d9e..78ddd867eb4c3f2b9278174287ea9aa55761c08a 100644
--- a/src/pl/tcl/test/test_setup.sql
+++ b/src/pl/tcl/test/test_setup.sql
@@ -1,3 +1,9 @@
+--
+-- checkpoint so that if we have a crash in the tests, replay of the
+-- just-completed CREATE DATABASE won't discard the core dump file
+--
+checkpoint;
+
--
-- Create the tables used in the test queries
--