sharpetronics/PostgreSQL
1
0
Fork 0
mirror of https://github.com/postgres/postgres.git synced 2025-06-06 00:02:36 -04:00
Code Issues Projects Releases Wiki Activity

Support PL/Tcl functions that return composite types and/or sets.

Browse Source 
Jim Nasby, rather heavily editorialized by me

Patch: <f2134651-14b3-efeb-f274-c69f3c084031@BlueTreble.com>
This commit is contained in:
Tom Lane 2016-11-06 17:56:05 -05:00
parent 2178cbf40d
commit 26abb50c49
6 changed files with 545 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
doc/src/sgml/pltcl.sgml
View File

@ -94,11 +94,11 @@ $$ LANGUAGE pltcl;
<para> <para>
The body of the function is simply a piece of Tcl script. The body of the function is simply a piece of Tcl script.
When the function is called, the argument values are passed as When the function is called, the argument values are passed to the
variables <literal>$1</literal> ... <literal>$<replaceable>n</replaceable></literal> to the Tcl script as variables named <literal>1</literal>
Tcl script. The result is returned ... <literal><replaceable>n</replaceable></literal>. The result is
from the Tcl code in the usual way, with a <literal>return</literal> returned from the Tcl code in the usual way, with
statement. a <literal>return</literal> statement.
</para> </para>
<para> <para>
@ -173,17 +173,57 @@ $$ LANGUAGE pltcl;
</para> </para>
<para> <para>
There is currently no support for returning a composite-type PL/Tcl functions can return composite-type results, too. To do this,
result value, nor for returning sets. the Tcl code must return a list of column name/value pairs matching
the expected result type. Any column names omitted from the list
are returned as nulls, and an error is raised if there are unexpected
column names. Here is an example:
<programlisting>
CREATE FUNCTION square_cube(in int, out squared int, out cubed int) AS $$
return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
$$ LANGUAGE pltcl;
</programlisting>
</para> </para>
<tip>
<para> <para>
<application>PL/Tcl</> does not currently have full support for The result list can be made from an array representation of the
domain types: it treats a domain the same as the underlying scalar desired tuple with the <literal>array get</> Tcl command. For example:
type. This means that constraints associated with the domain will
not be enforced. This is not an issue for function arguments, but <programlisting>
it is a hazard if you declare a <application>PL/Tcl</> function CREATE FUNCTION raise_pay(employee, delta int) RETURNS employee AS $$
as returning a domain type. set 1(salary) [expr {$1(salary) + $2}]
return [array get 1]
$$ LANGUAGE pltcl;
</programlisting>
</para>
</tip>
<para>
PL/Tcl functions can return sets. To do this, the Tcl code should
call <function>return_next</function> once per row to be returned,
passing either the appropriate value when returning a scalar type,
or a list of column name/value pairs when returning a composite type.
Here is an example returning a scalar type:
<programlisting>
CREATE FUNCTION sequence(int, int) RETURNS SETOF int AS $$
for {set i $1} {$i &lt; $2} {incr i} {
return_next $i
}
$$ LANGUAGE pltcl;
</programlisting>
and here is one returning a composite type:
<programlisting>
CREATE FUNCTION table_of_squares(int, int) RETURNS TABLE (x int, x2 int) AS $$
for {set i $1} {$i &lt; $2} {incr i} {
return_next [list x $i x2 [expr {$i * $i}]]
}
$$ LANGUAGE pltcl;
</programlisting>
</para> </para>
</sect1> </sect1>
@ -195,10 +235,9 @@ $$ LANGUAGE pltcl;
The argument values supplied to a PL/Tcl function's code are simply The argument values supplied to a PL/Tcl function's code are simply
the input arguments converted to text form (just as if they had been the input arguments converted to text form (just as if they had been
displayed by a <command>SELECT</> statement). Conversely, the displayed by a <command>SELECT</> statement). Conversely, the
<literal>return</> <literal>return</> and <literal>return_next</> commands will accept
command will accept any string that is acceptable input format for any string that is acceptable input format for the function's declared
the function's declared return type. So, within the PL/Tcl function, result type, or for the specified column of a composite result type.
all values are just text strings.
</para> </para>
</sect1> </sect1>

61
src/pl/tcl/expected/pltcl_queries.out
View File

@ -303,3 +303,64 @@ select tcl_lastoid('t2') > 0;
t t
(1 row) (1 row)
-- test some error cases
CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl;
SELECT tcl_error();
ERROR: missing close-brace
CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ LANGUAGE pltcl;
SELECT bad_record();
ERROR: column name/value list must have even number of elements
CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 cow 3]$$ LANGUAGE pltcl;
SELECT bad_field();
ERROR: column name/value list contains nonexistent column name "cow"
-- test compound return
select * from tcl_test_cube_squared(5);
squared | cubed
---------+-------
25 | 125
(1 row)
-- test SRF
select * from tcl_test_squared_rows(0,5);
x | y
---+----
0 | 0
1 | 1
2 | 4
3 | 9
4 | 16
(5 rows)
select * from tcl_test_sequence(0,5) as a;
a
---
0
1
2
3
4
(5 rows)
select 1, tcl_test_sequence(0,5);
?column? | tcl_test_sequence
----------+-------------------
1 | 0
1 | 1
1 | 2
1 | 3
1 | 4
(5 rows)
CREATE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl;
select non_srf();
ERROR: return_next cannot be used in non-set-returning functions
CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
return_next [list a]
$$ LANGUAGE pltcl;
SELECT bad_record_srf();
ERROR: column name/value list must have even number of elements
CREATE FUNCTION bad_field_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
return_next [list a 1 b 2 cow 3]
$$ LANGUAGE pltcl;
SELECT bad_field_srf();
ERROR: column name/value list contains nonexistent column name "cow"

13
src/pl/tcl/expected/pltcl_setup.out
View File

@ -555,6 +555,19 @@ NOTICE: tclsnitch: ddl_command_start DROP TABLE
NOTICE: tclsnitch: ddl_command_end DROP TABLE NOTICE: tclsnitch: ddl_command_end DROP TABLE
drop event trigger tcl_a_snitch; drop event trigger tcl_a_snitch;
drop event trigger tcl_b_snitch; drop event trigger tcl_b_snitch;
CREATE FUNCTION tcl_test_cube_squared(in int, out squared int, out cubed int) AS $$
return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
$$ language pltcl;
CREATE FUNCTION tcl_test_squared_rows(int,int) RETURNS TABLE (x int, y int) AS $$
for {set i $1} {$i < $2} {incr i} {
return_next [list y [expr {$i * $i}] x $i]
}
$$ language pltcl;
CREATE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$
for {set i $1} {$i < $2} {incr i} {
return_next $i
}
$$ language pltcl;
-- test use of errorCode in error handling -- test use of errorCode in error handling
create function tcl_error_handling_test() returns text as $$ create function tcl_error_handling_test() returns text as $$
global errorCode global errorCode

430
src/pl/tcl/pltcl.c
View File

@ -21,6 +21,7 @@
#include "commands/trigger.h" #include "commands/trigger.h"
#include "executor/spi.h" #include "executor/spi.h"
#include "fmgr.h" #include "fmgr.h"
#include "funcapi.h"
#include "mb/pg_wchar.h" #include "mb/pg_wchar.h"
#include "miscadmin.h" #include "miscadmin.h"
#include "nodes/makefuncs.h" #include "nodes/makefuncs.h"
@ -123,6 +124,9 @@ typedef struct pltcl_interp_desc
* problem to manage its memory when we replace a proc definition. We do * problem to manage its memory when we replace a proc definition. We do
* not clean up pltcl_proc_descs when a pg_proc row is deleted, only when * not clean up pltcl_proc_descs when a pg_proc row is deleted, only when
* it is updated, and the same policy applies to Tcl's copy as well.) * it is updated, and the same policy applies to Tcl's copy as well.)
*
* Note that the data in this struct is shared across all active calls;
* nothing except the fn_refcount should be changed by a call instance.
**********************************************************************/ **********************************************************************/
typedef struct pltcl_proc_desc typedef struct pltcl_proc_desc
{ {
@ -137,6 +141,8 @@ typedef struct pltcl_proc_desc
pltcl_interp_desc *interp_desc; /* interpreter to use */ pltcl_interp_desc *interp_desc; /* interpreter to use */
FmgrInfo result_in_func; /* input function for fn's result type */ FmgrInfo result_in_func; /* input function for fn's result type */
Oid result_typioparam; /* param to pass to same */ Oid result_typioparam; /* param to pass to same */
bool fn_retisset; /* true if function returns a set */
bool fn_retistuple; /* true if function returns composite */
int nargs; /* number of arguments */ int nargs; /* number of arguments */
/* these arrays have nargs entries: */ /* these arrays have nargs entries: */
FmgrInfo *arg_out_func; /* output fns for arg types */ FmgrInfo *arg_out_func; /* output fns for arg types */
@ -188,6 +194,32 @@ typedef struct pltcl_proc_ptr
} pltcl_proc_ptr; } pltcl_proc_ptr;
/**********************************************************************
* Per-call state
**********************************************************************/
typedef struct pltcl_call_state
{
/* Call info struct, or NULL in a trigger */
FunctionCallInfo fcinfo;
/* Function we're executing (NULL if not yet identified) */
pltcl_proc_desc *prodesc;
/*
* Information for SRFs and functions returning composite types.
* ret_tupdesc and attinmeta are set up if either fn_retistuple or
* fn_retisset, since even a scalar-returning SRF needs a tuplestore.
*/
TupleDesc ret_tupdesc; /* return rowtype, if retistuple or retisset */
AttInMetadata *attinmeta; /* metadata for building tuples of that type */
ReturnSetInfo *rsi; /* passed-in ReturnSetInfo, if any */
Tuplestorestate *tuple_store; /* SRFs accumulate result here */
MemoryContext tuple_store_cxt; /* context and resowner for tuplestore */
ResourceOwner tuple_store_owner;
} pltcl_call_state;
/********************************************************************** /**********************************************************************
* Global data * Global data
**********************************************************************/ **********************************************************************/
@ -196,9 +228,8 @@ static Tcl_Interp *pltcl_hold_interp = NULL;
static HTAB *pltcl_interp_htab = NULL; static HTAB *pltcl_interp_htab = NULL;
static HTAB *pltcl_proc_htab = NULL; static HTAB *pltcl_proc_htab = NULL;
/* these are saved and restored by pltcl_handler */ /* this is saved and restored by pltcl_handler */
static FunctionCallInfo pltcl_current_fcinfo = NULL; static pltcl_call_state *pltcl_current_call_state = NULL;
static pltcl_proc_desc *pltcl_current_prodesc = NULL;
/********************************************************************** /**********************************************************************
* Lookup table for SQLSTATE condition names * Lookup table for SQLSTATE condition names
@ -225,10 +256,12 @@ static void pltcl_init_load_unknown(Tcl_Interp *interp);
static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted); static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted); static Datum pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
bool pltrusted);
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted); static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted); bool pltrusted);
static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
bool pltrusted);
static void throw_tcl_error(Tcl_Interp *interp, const char *proname); static void throw_tcl_error(Tcl_Interp *interp, const char *proname);
@ -246,7 +279,8 @@ static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]); int objc, Tcl_Obj *const objv[]);
static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]); int objc, Tcl_Obj *const objv[]);
static int pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]); int objc, Tcl_Obj *const objv[]);
static int pltcl_process_SPI_result(Tcl_Interp *interp, static int pltcl_process_SPI_result(Tcl_Interp *interp,
@ -265,6 +299,10 @@ static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname, static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname,
uint64 tupno, HeapTuple tuple, TupleDesc tupdesc); uint64 tupno, HeapTuple tuple, TupleDesc tupdesc);
static Tcl_Obj *pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc); static Tcl_Obj *pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc);
static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp,
Tcl_Obj **kvObjv, int kvObjc,
pltcl_call_state *call_state);
static void pltcl_init_tuple_store(pltcl_call_state *call_state);
/* /*
@ -432,7 +470,8 @@ pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted)
pltcl_argisnull, NULL, NULL); pltcl_argisnull, NULL, NULL);
Tcl_CreateObjCommand(interp, "return_null", Tcl_CreateObjCommand(interp, "return_null",
pltcl_returnnull, NULL, NULL); pltcl_returnnull, NULL, NULL);
Tcl_CreateObjCommand(interp, "return_next",
pltcl_returnnext, NULL, NULL);
Tcl_CreateObjCommand(interp, "spi_exec", Tcl_CreateObjCommand(interp, "spi_exec",
pltcl_SPI_execute, NULL, NULL); pltcl_SPI_execute, NULL, NULL);
Tcl_CreateObjCommand(interp, "spi_prepare", Tcl_CreateObjCommand(interp, "spi_prepare",
@ -625,29 +664,33 @@ pltclu_call_handler(PG_FUNCTION_ARGS)
} }
/**********************************************************************
* pltcl_handler() - Handler for function and trigger calls, for
* both trusted and untrusted interpreters.
**********************************************************************/
static Datum static Datum
pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
{ {
Datum retval; Datum retval;
FunctionCallInfo save_fcinfo; pltcl_call_state current_call_state;
pltcl_proc_desc *save_prodesc; pltcl_call_state *save_call_state;
pltcl_proc_desc *this_prodesc;
/* /*
* Ensure that static pointers are saved/restored properly * Initialize current_call_state to nulls/zeroes; in particular, set its
* prodesc pointer to null. Anything that sets it non-null should
* increase the prodesc's fn_refcount at the same time. We'll decrease
* the refcount, and then delete the prodesc if it's no longer referenced,
* on the way out of this function. This ensures that prodescs live as
* long as needed even if somebody replaces the originating pg_proc row
* while they're executing.
*/ */
save_fcinfo = pltcl_current_fcinfo; memset(&current_call_state, 0, sizeof(current_call_state));
save_prodesc = pltcl_current_prodesc;
/* /*
* Reset pltcl_current_prodesc to null. Anything that sets it non-null * Ensure that static pointer is saved/restored properly
* should increase the prodesc's fn_refcount at the same time. We'll
* decrease the refcount, and then delete the prodesc if it's no longer
* referenced, on the way out of this function. This ensures that
* prodescs live as long as needed even if somebody replaces the
* originating pg_proc row while they're executing.
*/ */
pltcl_current_prodesc = NULL; save_call_state = pltcl_current_call_state;
pltcl_current_call_state = &current_call_state;
PG_TRY(); PG_TRY();
{ {
@ -657,47 +700,46 @@ pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
*/ */
if (CALLED_AS_TRIGGER(fcinfo)) if (CALLED_AS_TRIGGER(fcinfo))
{ {
pltcl_current_fcinfo = NULL; /* invoke the trigger handler */
retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted)); retval = PointerGetDatum(pltcl_trigger_handler(fcinfo,
&current_call_state,
pltrusted));
} }
else if (CALLED_AS_EVENT_TRIGGER(fcinfo)) else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
{ {
pltcl_current_fcinfo = NULL; /* invoke the event trigger handler */
pltcl_event_trigger_handler(fcinfo, pltrusted); pltcl_event_trigger_handler(fcinfo, &current_call_state, pltrusted);
retval = (Datum) 0; retval = (Datum) 0;
} }
else else
{ {
pltcl_current_fcinfo = fcinfo; /* invoke the regular function handler */
retval = pltcl_func_handler(fcinfo, pltrusted); current_call_state.fcinfo = fcinfo;
retval = pltcl_func_handler(fcinfo, &current_call_state, pltrusted);
} }
} }
PG_CATCH(); PG_CATCH();
{ {
/* Restore globals, then clean up the prodesc refcount if any */ /* Restore static pointer, then clean up the prodesc refcount if any */
this_prodesc = pltcl_current_prodesc; pltcl_current_call_state = save_call_state;
pltcl_current_fcinfo = save_fcinfo; if (current_call_state.prodesc != NULL)
pltcl_current_prodesc = save_prodesc;
if (this_prodesc != NULL)
{ {
Assert(this_prodesc->fn_refcount > 0); Assert(current_call_state.prodesc->fn_refcount > 0);
if (--this_prodesc->fn_refcount == 0) if (--current_call_state.prodesc->fn_refcount == 0)
MemoryContextDelete(this_prodesc->fn_cxt); MemoryContextDelete(current_call_state.prodesc->fn_cxt);
} }
PG_RE_THROW(); PG_RE_THROW();
} }
PG_END_TRY(); PG_END_TRY();
/* Restore globals, then clean up the prodesc refcount if any */ /* Restore static pointer, then clean up the prodesc refcount if any */
/* (We're being paranoid in case an error is thrown in context deletion) */ /* (We're being paranoid in case an error is thrown in context deletion) */
this_prodesc = pltcl_current_prodesc; pltcl_current_call_state = save_call_state;
pltcl_current_fcinfo = save_fcinfo; if (current_call_state.prodesc != NULL)
pltcl_current_prodesc = save_prodesc;
if (this_prodesc != NULL)
{ {
Assert(this_prodesc->fn_refcount > 0); Assert(current_call_state.prodesc->fn_refcount > 0);
if (--this_prodesc->fn_refcount == 0) if (--current_call_state.prodesc->fn_refcount == 0)
MemoryContextDelete(this_prodesc->fn_cxt); MemoryContextDelete(current_call_state.prodesc->fn_cxt);
} }
return retval; return retval;
@ -708,7 +750,8 @@ pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
* pltcl_func_handler() - Handler for regular function calls * pltcl_func_handler() - Handler for regular function calls
**********************************************************************/ **********************************************************************/
static Datum static Datum
pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted) pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
bool pltrusted)
{ {
pltcl_proc_desc *prodesc; pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp; Tcl_Interp *volatile interp;
@ -725,11 +768,32 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
false, pltrusted); false, pltrusted);
pltcl_current_prodesc = prodesc; call_state->prodesc = prodesc;
prodesc->fn_refcount++; prodesc->fn_refcount++;
interp = prodesc->interp_desc->interp; interp = prodesc->interp_desc->interp;
/*
* If we're a SRF, check caller can handle materialize mode, and save
* relevant info into call_state. We must ensure that the returned
* tuplestore is owned by the caller's context, even if we first create it
* inside a subtransaction.
*/
if (prodesc->fn_retisset)
{
ReturnSetInfo *rsi = (ReturnSetInfo *) fcinfo->resultinfo;
if (!rsi || !IsA(rsi, ReturnSetInfo) ||
(rsi->allowedModes & SFRM_Materialize) == 0)
ereport(ERROR,
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("set-valued function called in context that cannot accept a set")));
call_state->rsi = rsi;
call_state->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory;
call_state->tuple_store_owner = CurrentResourceOwner;
}
/************************************************************ /************************************************************
* Create the tcl command to call the internal * Create the tcl command to call the internal
* proc in the Tcl interpreter * proc in the Tcl interpreter
@ -838,11 +902,72 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
if (SPI_finish() != SPI_OK_FINISH) if (SPI_finish() != SPI_OK_FINISH)
elog(ERROR, "SPI_finish() failed"); elog(ERROR, "SPI_finish() failed");
if (fcinfo->isnull) if (prodesc->fn_retisset)
{
ReturnSetInfo *rsi = call_state->rsi;
/* We already checked this is OK */
rsi->returnMode = SFRM_Materialize;
/* If we produced any tuples, send back the result */
if (call_state->tuple_store)
{
rsi->setResult = call_state->tuple_store;
if (call_state->ret_tupdesc)
{
MemoryContext oldcxt;
oldcxt = MemoryContextSwitchTo(call_state->tuple_store_cxt);
rsi->setDesc = CreateTupleDescCopy(call_state->ret_tupdesc);
MemoryContextSwitchTo(oldcxt);
}
}
retval = (Datum) 0;
fcinfo->isnull = true;
}
else if (fcinfo->isnull)
{
retval = InputFunctionCall(&prodesc->result_in_func, retval = InputFunctionCall(&prodesc->result_in_func,
NULL, NULL,
prodesc->result_typioparam, prodesc->result_typioparam,
-1); -1);
}
else if (prodesc->fn_retistuple)
{
TupleDesc td;
HeapTuple tup;
Tcl_Obj *resultObj;
Tcl_Obj **resultObjv;
int resultObjc;
/*
* Set up data about result type. XXX it's tempting to consider
* caching this in the prodesc, in the common case where the rowtype
* is determined by the function not the calling query. But we'd have
* to be able to deal with ADD/DROP/ALTER COLUMN events when the
* result type is a named composite type, so it's not exactly trivial.
* Maybe worth improving someday.
*/
if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
ereport(ERROR,
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("function returning record called in context "
"that cannot accept type record")));
Assert(!call_state->ret_tupdesc);
Assert(!call_state->attinmeta);
call_state->ret_tupdesc = td;
call_state->attinmeta = TupleDescGetAttInMetadata(td);
/* Convert function result to tuple */
resultObj = Tcl_GetObjResult(interp);
if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
throw_tcl_error(interp, prodesc->user_proname);
tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc,
call_state);
retval = HeapTupleGetDatum(tup);
}
else else
retval = InputFunctionCall(&prodesc->result_in_func, retval = InputFunctionCall(&prodesc->result_in_func,
utf_u2e(Tcl_GetStringResult(interp)), utf_u2e(Tcl_GetStringResult(interp)),
@ -857,7 +982,8 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
* pltcl_trigger_handler() - Handler for trigger calls * pltcl_trigger_handler() - Handler for trigger calls
**********************************************************************/ **********************************************************************/
static HeapTuple static HeapTuple
pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted) pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
bool pltrusted)
{ {
pltcl_proc_desc *prodesc; pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp; Tcl_Interp *volatile interp;
@ -886,7 +1012,7 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
false, /* not an event trigger */ false, /* not an event trigger */
pltrusted); pltrusted);
pltcl_current_prodesc = prodesc; call_state->prodesc = prodesc;
prodesc->fn_refcount++; prodesc->fn_refcount++;
interp = prodesc->interp_desc->interp; interp = prodesc->interp_desc->interp;
@ -1169,7 +1295,8 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
* pltcl_event_trigger_handler() - Handler for event trigger calls * pltcl_event_trigger_handler() - Handler for event trigger calls
**********************************************************************/ **********************************************************************/
static void static void
pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted) pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
bool pltrusted)
{ {
pltcl_proc_desc *prodesc; pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp; Tcl_Interp *volatile interp;
@ -1185,7 +1312,7 @@ pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
InvalidOid, true, pltrusted); InvalidOid, true, pltrusted);
pltcl_current_prodesc = prodesc; call_state->prodesc = prodesc;
prodesc->fn_refcount++; prodesc->fn_refcount++;
interp = prodesc->interp_desc->interp; interp = prodesc->interp_desc->interp;
@ -1389,10 +1516,11 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
procStruct->prorettype); procStruct->prorettype);
typeStruct = (Form_pg_type) GETSTRUCT(typeTup); typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
/* Disallow pseudotype result, except VOID */ /* Disallow pseudotype result, except VOID and RECORD */
if (typeStruct->typtype == TYPTYPE_PSEUDO) if (typeStruct->typtype == TYPTYPE_PSEUDO)
{ {
if (procStruct->prorettype == VOIDOID) if (procStruct->prorettype == VOIDOID ||
procStruct->prorettype == RECORDOID)
/* okay */ ; /* okay */ ;
else if (procStruct->prorettype == TRIGGEROID || else if (procStruct->prorettype == TRIGGEROID ||
procStruct->prorettype == EVTTRIGGEROID) procStruct->prorettype == EVTTRIGGEROID)
@ -1406,16 +1534,15 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
format_type_be(procStruct->prorettype)))); format_type_be(procStruct->prorettype))));
} }
if (typeStruct->typtype == TYPTYPE_COMPOSITE)
ereport(ERROR,
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("PL/Tcl functions cannot return composite types")));
fmgr_info_cxt(typeStruct->typinput, fmgr_info_cxt(typeStruct->typinput,
&(prodesc->result_in_func), &(prodesc->result_in_func),
proc_cxt); proc_cxt);
prodesc->result_typioparam = getTypeIOParam(typeTup); prodesc->result_typioparam = getTypeIOParam(typeTup);
prodesc->fn_retisset = procStruct->proretset;
prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID ||
typeStruct->typtype == TYPTYPE_COMPOSITE);
ReleaseSysCache(typeTup); ReleaseSysCache(typeTup);
} }
@ -1914,7 +2041,7 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]) int objc, Tcl_Obj *const objv[])
{ {
int argno; int argno;
FunctionCallInfo fcinfo = pltcl_current_fcinfo; FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo;
/************************************************************ /************************************************************
* Check call syntax * Check call syntax
@ -1967,7 +2094,7 @@ static int
pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]) int objc, Tcl_Obj *const objv[])
{ {
FunctionCallInfo fcinfo = pltcl_current_fcinfo; FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo;
/************************************************************ /************************************************************
* Check call syntax * Check call syntax
@ -1998,6 +2125,95 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
} }
/**********************************************************************
* pltcl_returnnext() - Add a row to the result tuplestore in a SRF.
**********************************************************************/
static int
pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[])
{
pltcl_call_state *call_state = pltcl_current_call_state;
FunctionCallInfo fcinfo = call_state->fcinfo;
pltcl_proc_desc *prodesc = call_state->prodesc;
int result = TCL_OK;
MemoryContext tmpcxt;
MemoryContext oldcxt;
/*
* Check that we're called as a set-returning function
*/
if (fcinfo == NULL)
{
Tcl_SetObjResult(interp,
Tcl_NewStringObj("return_next cannot be used in triggers", -1));
return TCL_ERROR;
}
if (!prodesc->fn_retisset)
{
Tcl_SetObjResult(interp,
Tcl_NewStringObj("return_next cannot be used in non-set-returning functions", -1));
return TCL_ERROR;
}
/*
* Check call syntax
*/
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "result");
return TCL_ERROR;
}
/* Set up tuple store if first output row */
if (call_state->tuple_store == NULL)
pltcl_init_tuple_store(call_state);
/* Make short-lived context to run input functions in */
tmpcxt = AllocSetContextCreate(CurrentMemoryContext,
"pltcl_returnnext",
ALLOCSET_SMALL_SIZES);
oldcxt = MemoryContextSwitchTo(tmpcxt);
if (prodesc->fn_retistuple)
{
Tcl_Obj **rowObjv;
int rowObjc;
/* result should be a list, so break it down */
if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
result = TCL_ERROR;
else
{
HeapTuple tuple;
SPI_push();
tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc,
call_state);
tuplestore_puttuple(call_state->tuple_store, tuple);
SPI_pop();
}
}
else
{
Datum retval;
bool isNull = false;
retval = InputFunctionCall(&prodesc->result_in_func,
utf_u2e((char *) Tcl_GetString(objv[1])),
prodesc->result_typioparam,
-1);
tuplestore_putvalues(call_state->tuple_store, call_state->ret_tupdesc,
&retval, &isNull);
}
MemoryContextSwitchTo(oldcxt);
MemoryContextDelete(tmpcxt);
return result;
}
/*---------- /*----------
* Support for running SPI operations inside subtransactions * Support for running SPI operations inside subtransactions
* *
@ -2164,7 +2380,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
{ {
UTF_BEGIN; UTF_BEGIN;
spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])), spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])),
pltcl_current_prodesc->fn_readonly, count); pltcl_current_call_state->prodesc->fn_readonly, count);
UTF_END; UTF_END;
my_rc = pltcl_process_SPI_result(interp, my_rc = pltcl_process_SPI_result(interp,
@ -2414,7 +2630,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
* Insert a hashtable entry for the plan and return * Insert a hashtable entry for the plan and return
* the key to the caller * the key to the caller
************************************************************/ ************************************************************/
query_hash = &pltcl_current_prodesc->interp_desc->query_hash; query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash;
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew); hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc); Tcl_SetHashValue(hashent, (ClientData) qdesc);
@ -2503,7 +2719,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
return TCL_ERROR; return TCL_ERROR;
} }
query_hash = &pltcl_current_prodesc->interp_desc->query_hash; query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash;
hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i])); hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i]));
if (hashent == NULL) if (hashent == NULL)
@ -2618,7 +2834,8 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
* Execute the plan * Execute the plan
************************************************************/ ************************************************************/
spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls, spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
pltcl_current_prodesc->fn_readonly, count); pltcl_current_call_state->prodesc->fn_readonly,
count);
my_rc = pltcl_process_SPI_result(interp, my_rc = pltcl_process_SPI_result(interp,
arrayname, arrayname,
@ -2808,3 +3025,88 @@ pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
return retobj; return retobj;
} }
/**********************************************************************
* pltcl_build_tuple_result() - Build a tuple of function's result rowtype
* from a Tcl list of column names and values
*
* Note: this function leaks memory. Even if we made it clean up its own
* mess, there's no way to prevent the datatype input functions it calls
* from leaking. Run it in a short-lived context, unless we're about to
* exit the procedure anyway.
*
* Also, caller is responsible for doing SPI_push/SPI_pop if calling from
* inside SPI environment.
**********************************************************************/
static HeapTuple
pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc,
pltcl_call_state *call_state)
{
char **values;
int i;
if (kvObjc % 2 != 0)
ereport(ERROR,
(errcode(ERRCODE_INVALID_PARAMETER_VALUE),
errmsg("column name/value list must have even number of elements")));
values = (char **) palloc0(call_state->ret_tupdesc->natts * sizeof(char *));
for (i = 0; i < kvObjc; i += 2)
{
char *fieldName = utf_e2u(Tcl_GetString(kvObjv[i]));
int attn = SPI_fnumber(call_state->ret_tupdesc, fieldName);
if (attn <= 0 || call_state->ret_tupdesc->attrs[attn - 1]->attisdropped)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("column name/value list contains nonexistent column name \"%s\"",
fieldName)));
values[attn - 1] = utf_e2u(Tcl_GetString(kvObjv[i + 1]));
}
return BuildTupleFromCStrings(call_state->attinmeta, values);
}
/**********************************************************************
* pltcl_init_tuple_store() - Initialize the result tuplestore for a SRF
**********************************************************************/
static void
pltcl_init_tuple_store(pltcl_call_state *call_state)
{
ReturnSetInfo *rsi = call_state->rsi;
MemoryContext oldcxt;
ResourceOwner oldowner;
/* Should be in a SRF */
Assert(rsi);
/* Should be first time through */
Assert(!call_state->tuple_store);
Assert(!call_state->attinmeta);
/* We expect caller to provide an appropriate result tupdesc */
Assert(rsi->expectedDesc);
call_state->ret_tupdesc = rsi->expectedDesc;
/*
* Switch to the right memory context and resource owner for storing the
* tuplestore. If we're within a subtransaction opened for an exception
* block, for example, we must still create the tuplestore in the resource
* owner that was active when this function was entered, and not in the
* subtransaction's resource owner.
*/
oldcxt = MemoryContextSwitchTo(call_state->tuple_store_cxt);
oldowner = CurrentResourceOwner;
CurrentResourceOwner = call_state->tuple_store_owner;
call_state->tuple_store =
tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
false, work_mem);
/* Build attinmeta in this context, too */
call_state->attinmeta = TupleDescGetAttInMetadata(call_state->ret_tupdesc);
CurrentResourceOwner = oldowner;
MemoryContextSwitchTo(oldcxt);
}

33
src/pl/tcl/sql/pltcl_queries.sql
View File

@ -97,3 +97,36 @@ create temp table t1 (f1 int);
select tcl_lastoid('t1'); select tcl_lastoid('t1');
create temp table t2 (f1 int) with oids; create temp table t2 (f1 int) with oids;
select tcl_lastoid('t2') > 0; select tcl_lastoid('t2') > 0;
-- test some error cases
CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl;
SELECT tcl_error();
CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ LANGUAGE pltcl;
SELECT bad_record();
CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 cow 3]$$ LANGUAGE pltcl;
SELECT bad_field();
-- test compound return
select * from tcl_test_cube_squared(5);
-- test SRF
select * from tcl_test_squared_rows(0,5);
select * from tcl_test_sequence(0,5) as a;
select 1, tcl_test_sequence(0,5);
CREATE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl;
select non_srf();
CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
return_next [list a]
$$ LANGUAGE pltcl;
SELECT bad_record_srf();
CREATE FUNCTION bad_field_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
return_next [list a 1 b 2 cow 3]
$$ LANGUAGE pltcl;
SELECT bad_field_srf();

16
src/pl/tcl/sql/pltcl_setup.sql
View File

@ -596,6 +596,22 @@ drop table foo;
drop event trigger tcl_a_snitch; drop event trigger tcl_a_snitch;
drop event trigger tcl_b_snitch; drop event trigger tcl_b_snitch;
CREATE FUNCTION tcl_test_cube_squared(in int, out squared int, out cubed int) AS $$
return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
$$ language pltcl;
CREATE FUNCTION tcl_test_squared_rows(int,int) RETURNS TABLE (x int, y int) AS $$
for {set i $1} {$i < $2} {incr i} {
return_next [list y [expr {$i * $i}] x $i]
}
$$ language pltcl;
CREATE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$
for {set i $1} {$i < $2} {incr i} {
return_next $i
}
$$ language pltcl;
-- test use of errorCode in error handling -- test use of errorCode in error handling
create function tcl_error_handling_test() returns text as $$ create function tcl_error_handling_test() returns text as $$