mirror of https://github.com/postgres/postgres
Clean up a number of bogosities around pltcl's handling of the Tcl "result":
1. Directly reading interp->result is deprecated in Tcl 8.0 and later; you're supposed to use Tcl_GetStringResult. This code finally broke with Tcl 8.5, because Tcl_GetVar can now have side-effects on interp->result even though it preserves the logical state of the result. (There's arguably a Tcl issue here, because Tcl_GetVar could invalidate the pointer result of a just-preceding Tcl_GetStringResult, but I doubt the Tcl guys will see it as a bug.) 2. We were being sloppy about the encoding of the result: some places would push database-encoding data into the Tcl result, which should not happen, and we were assuming that any error result coming back from Tcl was in the database encoding, which is not a good assumption. 3. There were a lot of calls of Tcl_SetResult that uselessly specified TCL_VOLATILE for constant strings. This is only a minor performance issue, but I fixed it in passing since I had to look at all the calls anyway. #2 is a live bug regardless of which Tcl version you are interested in, so back-patch even to branches that are unlikely to be used with Tcl 8.5. I went back as far as 8.0, which is as far as the patch applied easily; 7.4 was using a different error processing scheme that has got its own problems :-(
This commit is contained in:
Tom Lane
parent
9dac1b460f
commit
19a6bace94
|
|
@ -2,7 +2,7 @@
|
|||
* pltcl.c - PostgreSQL support for Tcl as
|
||||
* procedural language (PL)
|
||||
*
|
||||
* $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.120 2008/05/12 00:00:54 alvherre Exp $
|
||||
* $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.121 2008/06/17 00:52:43 tgl Exp $
|
||||
*
|
||||
**********************************************************************/
|
||||
|
||||
|
|
@ -36,6 +36,11 @@
|
|||
((TCL_MAJOR_VERSION > maj) || \
|
||||
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
|
||||
|
||||
/* In Tcl >= 8.0, really not supposed to touch interp->result directly */
|
||||
#if !HAVE_TCL_VERSION(8,0)
|
||||
#define Tcl_GetStringResult(interp) ((interp)->result)
|
||||
#endif
|
||||
|
||||
#if defined(UNICODE_CONVERSION) && HAVE_TCL_VERSION(8,1)
|
||||
|
||||
#include "mb/pg_wchar.h"
|
||||
|
|
@ -134,6 +139,8 @@ static Datum pltcl_func_handler(PG_FUNCTION_ARGS);
|
|||
|
||||
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS);
|
||||
|
||||
static void throw_tcl_error(Tcl_Interp *interp, const char *proname);
|
||||
|
||||
static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid);
|
||||
|
||||
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
|
||||
|
|
@ -224,7 +231,7 @@ pltcl_WaitForEvent(Tcl_Time *timePtr)
|
|||
{
|
||||
return 0;
|
||||
}
|
||||
#endif /* HAVE_TCL_VERSION(8,2) */
|
||||
#endif /* HAVE_TCL_VERSION(8,4) */
|
||||
|
||||
|
||||
/*
|
||||
|
|
@ -632,16 +639,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
|
|||
* Check for errors reported by Tcl.
|
||||
************************************************************/
|
||||
if (tcl_rc != TCL_OK)
|
||||
{
|
||||
UTF_BEGIN;
|
||||
ereport(ERROR,
|
||||
(errmsg("%s", interp->result),
|
||||
errcontext("%s\nin PL/Tcl function \"%s\"",
|
||||
UTF_U2E(Tcl_GetVar(interp, "errorInfo",
|
||||
TCL_GLOBAL_ONLY)),
|
||||
prodesc->user_proname)));
|
||||
UTF_END;
|
||||
}
|
||||
throw_tcl_error(interp, prodesc->user_proname);
|
||||
|
||||
/************************************************************
|
||||
* Disconnect from SPI manager and then create the return
|
||||
|
|
@ -649,8 +647,8 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
|
|||
* this must not be allocated in the SPI memory context
|
||||
* because SPI_finish would free it). But don't try to call
|
||||
* the result_in_func if we've been told to return a NULL;
|
||||
* the contents of interp->result may not be a valid value of
|
||||
* the result type in that case.
|
||||
* the Tcl result may not be a valid value of the result type
|
||||
* in that case.
|
||||
************************************************************/
|
||||
if (SPI_finish() != SPI_OK_FINISH)
|
||||
elog(ERROR, "SPI_finish() failed");
|
||||
|
|
@ -664,7 +662,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
|
|||
{
|
||||
UTF_BEGIN;
|
||||
retval = InputFunctionCall(&prodesc->result_in_func,
|
||||
UTF_U2E(interp->result),
|
||||
UTF_U2E((char *) Tcl_GetStringResult(interp)),
|
||||
prodesc->result_typioparam,
|
||||
-1);
|
||||
UTF_END;
|
||||
|
|
@ -695,6 +693,7 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
|
|||
Datum *modvalues;
|
||||
char *modnulls;
|
||||
int ret_numvals;
|
||||
CONST84 char *result;
|
||||
CONST84 char **ret_values;
|
||||
|
||||
/* Connect to SPI manager */
|
||||
|
|
@ -864,37 +863,35 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
|
|||
* Check for errors reported by Tcl.
|
||||
************************************************************/
|
||||
if (tcl_rc != TCL_OK)
|
||||
{
|
||||
UTF_BEGIN;
|
||||
ereport(ERROR,
|
||||
(errmsg("%s", interp->result),
|
||||
errcontext("%s\nin PL/Tcl function \"%s\"",
|
||||
UTF_U2E(Tcl_GetVar(interp, "errorInfo",
|
||||
TCL_GLOBAL_ONLY)),
|
||||
prodesc->user_proname)));
|
||||
UTF_END;
|
||||
}
|
||||
throw_tcl_error(interp, prodesc->user_proname);
|
||||
|
||||
/************************************************************
|
||||
* The return value from the procedure might be one of
|
||||
* the magic strings OK or SKIP or a list from array get
|
||||
* the magic strings OK or SKIP or a list from array get.
|
||||
* We can check for OK or SKIP without worrying about encoding.
|
||||
************************************************************/
|
||||
if (SPI_finish() != SPI_OK_FINISH)
|
||||
elog(ERROR, "SPI_finish() failed");
|
||||
|
||||
if (strcmp(interp->result, "OK") == 0)
|
||||
result = Tcl_GetStringResult(interp);
|
||||
|
||||
if (strcmp(result, "OK") == 0)
|
||||
return rettup;
|
||||
if (strcmp(interp->result, "SKIP") == 0)
|
||||
if (strcmp(result, "SKIP") == 0)
|
||||
return (HeapTuple) NULL;
|
||||
|
||||
/************************************************************
|
||||
* Convert the result value from the Tcl interpreter
|
||||
* and setup structures for SPI_modifytuple();
|
||||
************************************************************/
|
||||
if (Tcl_SplitList(interp, interp->result,
|
||||
if (Tcl_SplitList(interp, result,
|
||||
&ret_numvals, &ret_values) != TCL_OK)
|
||||
{
|
||||
UTF_BEGIN;
|
||||
elog(ERROR, "could not split return value from trigger: %s",
|
||||
interp->result);
|
||||
UTF_U2E(Tcl_GetStringResult(interp)));
|
||||
UTF_END;
|
||||
}
|
||||
|
||||
/* Use a TRY to ensure ret_values will get freed */
|
||||
PG_TRY();
|
||||
|
|
@ -994,6 +991,36 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
|
|||
}
|
||||
|
||||
|
||||
/**********************************************************************
|
||||
* throw_tcl_error - ereport an error returned from the Tcl interpreter
|
||||
**********************************************************************/
|
||||
static void
|
||||
throw_tcl_error(Tcl_Interp *interp, const char *proname)
|
||||
{
|
||||
/*
|
||||
* Caution is needed here because Tcl_GetVar could overwrite the
|
||||
* interpreter result (even though it's not really supposed to),
|
||||
* and we can't control the order of evaluation of ereport arguments.
|
||||
* Hence, make real sure we have our own copy of the result string
|
||||
* before invoking Tcl_GetVar.
|
||||
*/
|
||||
char *emsg;
|
||||
char *econtext;
|
||||
|
||||
UTF_BEGIN;
|
||||
emsg = pstrdup(UTF_U2E(Tcl_GetStringResult(interp)));
|
||||
UTF_END;
|
||||
UTF_BEGIN;
|
||||
econtext = UTF_U2E((char *) Tcl_GetVar(interp, "errorInfo",
|
||||
TCL_GLOBAL_ONLY));
|
||||
ereport(ERROR,
|
||||
(errmsg("%s", emsg),
|
||||
errcontext("%s\nin PL/Tcl function \"%s\"",
|
||||
econtext, proname)));
|
||||
UTF_END;
|
||||
}
|
||||
|
||||
|
||||
/**********************************************************************
|
||||
* compile_pltcl_function - compile (or hopefully just look up) function
|
||||
*
|
||||
|
|
@ -1319,8 +1346,10 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
|
|||
free(prodesc->user_proname);
|
||||
free(prodesc->internal_proname);
|
||||
free(prodesc);
|
||||
UTF_BEGIN;
|
||||
elog(ERROR, "could not create internal procedure \"%s\": %s",
|
||||
internal_proname, interp->result);
|
||||
internal_proname, UTF_U2E(Tcl_GetStringResult(interp)));
|
||||
UTF_END;
|
||||
}
|
||||
|
||||
/************************************************************
|
||||
|
|
@ -1349,8 +1378,7 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
|
|||
|
||||
if (argc != 3)
|
||||
{
|
||||
Tcl_SetResult(interp, "syntax error - 'elog level msg'",
|
||||
TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1375,11 +1403,26 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
|
|||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/************************************************************
|
||||
* 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
|
||||
if (level == ERROR)
|
||||
{
|
||||
/*
|
||||
* We just pass the error back to Tcl. If it's not caught,
|
||||
* it'll eventually get converted to a PG error when we reach
|
||||
* the call handler.
|
||||
*/
|
||||
Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* For non-error messages, just pass 'em to elog(). We do not expect
|
||||
* that this will fail, but just on the off chance it does, report the
|
||||
* error back to Tcl. Note we are assuming that elog() can't have any
|
||||
* internal failures that are so bad as to require a transaction abort.
|
||||
************************************************************/
|
||||
*
|
||||
* This path is also used for FATAL errors, which aren't going to come
|
||||
* back to us at all.
|
||||
*/
|
||||
oldcontext = CurrentMemoryContext;
|
||||
PG_TRY();
|
||||
{
|
||||
|
|
@ -1397,7 +1440,9 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
|
|||
FlushErrorState();
|
||||
|
||||
/* Pass the error message to Tcl */
|
||||
Tcl_SetResult(interp, edata->message, TCL_VOLATILE);
|
||||
UTF_BEGIN;
|
||||
Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
|
||||
UTF_END;
|
||||
FreeErrorData(edata);
|
||||
|
||||
return TCL_ERROR;
|
||||
|
|
@ -1425,7 +1470,7 @@ pltcl_quote(ClientData cdata, Tcl_Interp *interp,
|
|||
************************************************************/
|
||||
if (argc != 2)
|
||||
{
|
||||
Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1477,7 +1522,8 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
|
|||
************************************************************/
|
||||
if (argc != 2)
|
||||
{
|
||||
Tcl_SetResult(interp, "syntax error - 'argisnull argno'", TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "syntax error - 'argisnull argno'",
|
||||
TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1487,7 +1533,7 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
|
|||
if (fcinfo == NULL)
|
||||
{
|
||||
Tcl_SetResult(interp, "argisnull cannot be used in triggers",
|
||||
TCL_VOLATILE);
|
||||
TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1503,7 +1549,7 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
|
|||
argno--;
|
||||
if (argno < 0 || argno >= fcinfo->nargs)
|
||||
{
|
||||
Tcl_SetResult(interp, "argno out of range", TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1511,9 +1557,9 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
|
|||
* Get the requested NULL state
|
||||
************************************************************/
|
||||
if (PG_ARGISNULL(argno))
|
||||
Tcl_SetResult(interp, "1", TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "1", TCL_STATIC);
|
||||
else
|
||||
Tcl_SetResult(interp, "0", TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "0", TCL_STATIC);
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
|
@ -1533,7 +1579,7 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
|
|||
************************************************************/
|
||||
if (argc != 1)
|
||||
{
|
||||
Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1543,7 +1589,7 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
|
|||
if (fcinfo == NULL)
|
||||
{
|
||||
Tcl_SetResult(interp, "return_null cannot be used in triggers",
|
||||
TCL_VOLATILE);
|
||||
TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1629,7 +1675,9 @@ pltcl_subtrans_abort(Tcl_Interp *interp,
|
|||
SPI_restore_connection();
|
||||
|
||||
/* Pass the error message to Tcl */
|
||||
Tcl_SetResult(interp, edata->message, TCL_VOLATILE);
|
||||
UTF_BEGIN;
|
||||
Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
|
||||
UTF_END;
|
||||
FreeErrorData(edata);
|
||||
}
|
||||
|
||||
|
|
@ -1661,7 +1709,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
|
|||
************************************************************/
|
||||
if (argc < 2)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1672,7 +1720,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
|
|||
{
|
||||
if (++i >= argc)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
arrayname = argv[i++];
|
||||
|
|
@ -1683,7 +1731,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
|
|||
{
|
||||
if (++i >= argc)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
|
||||
|
|
@ -1697,7 +1745,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
|
|||
query_idx = i;
|
||||
if (query_idx >= argc || query_idx + 2 < argc)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (query_idx + 1 < argc)
|
||||
|
|
@ -1769,7 +1817,7 @@ pltcl_process_SPI_result(Tcl_Interp *interp,
|
|||
case SPI_OK_UTILITY:
|
||||
if (tuptable == NULL)
|
||||
{
|
||||
Tcl_SetResult(interp, "0", TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "0", TCL_STATIC);
|
||||
break;
|
||||
}
|
||||
/* FALL THRU for utility returning tuples */
|
||||
|
|
@ -1873,7 +1921,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
|
|||
if (argc != 3)
|
||||
{
|
||||
Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
|
||||
TCL_VOLATILE);
|
||||
TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -1974,6 +2022,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
|
|||
|
||||
ckfree((char *) args);
|
||||
|
||||
/* qname is ASCII, so no need for encoding conversion */
|
||||
Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
|
@ -2017,7 +2066,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
|
|||
{
|
||||
if (++i >= argc)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
arrayname = argv[i++];
|
||||
|
|
@ -2027,7 +2076,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
|
|||
{
|
||||
if (++i >= argc)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
nulls = argv[i++];
|
||||
|
|
@ -2037,7 +2086,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
|
|||
{
|
||||
if (++i >= argc)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
|
||||
|
|
@ -2053,7 +2102,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
|
|||
************************************************************/
|
||||
if (i >= argc)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -2080,7 +2129,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
|
|||
{
|
||||
Tcl_SetResult(interp,
|
||||
"length of nulls string doesn't match # of arguments",
|
||||
TCL_VOLATILE);
|
||||
TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
|
@ -2093,7 +2142,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
|
|||
{
|
||||
if (i >= argc)
|
||||
{
|
||||
Tcl_SetResult(interp, "missing argument list", TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
@ -2110,7 +2159,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
|
|||
{
|
||||
Tcl_SetResult(interp,
|
||||
"argument list length doesn't match # of arguments for query",
|
||||
TCL_VOLATILE);
|
||||
TCL_STATIC);
|
||||
ckfree((char *) callargs);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
|
@ -2126,7 +2175,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
|
|||
|
||||
if (i != argc)
|
||||
{
|
||||
Tcl_SetResult(interp, usage, TCL_VOLATILE);
|
||||
Tcl_SetResult(interp, usage, TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue