diff options
| -rw-r--r-- | doc/src/sgml/plperl.sgml | 12 | ||||
| -rw-r--r-- | doc/src/sgml/pltcl.sgml | 26 | ||||
| -rw-r--r-- | doc/src/sgml/release.sgml | 11 | ||||
| -rw-r--r-- | src/pl/plperl/plperl.c | 92 | ||||
| -rw-r--r-- | src/pl/tcl/pltcl.c | 653 | ||||
| -rwxr-xr-x | src/pl/tcl/test/runtest | 2 | ||||
| -rw-r--r-- | src/pl/tcl/test/test_queries.sql | 2 | ||||
| -rw-r--r-- | src/pl/tcl/test/test_setup.sql | 6 |
8 files changed, 409 insertions, 395 deletions
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml index 7893d263775..7642f50ca45 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 09f8f82eaa4..b454c6a45f8 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 e0d58a0ee0a..39f6f763c9b 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 d2746641852..36665cff271 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 da1cee09adf..a95344759a3 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,26 +1927,21 @@ 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 " @@ -1913,15 +1949,6 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, "?-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 ************************************************************/ i = 1; @@ -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 32c1433b85e..50b2be07751 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 98bc513b4ce..9cb059ed15f 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 568a2b3aeb0..78ddd867eb4 100644 --- a/src/pl/tcl/test/test_setup.sql +++ b/src/pl/tcl/test/test_setup.sql @@ -1,4 +1,10 @@ -- +-- 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 -- -- T_pkey1 is the primary key table for T_dta1. Entries from T_pkey1 |