diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml index 805cc89..1c185cb 100644 *** a/doc/src/sgml/pltcl.sgml --- b/doc/src/sgml/pltcl.sgml *************** $$ LANGUAGE pltcl; *** 173,180 **** ! There is currently no support for returning a composite-type ! result value, nor for returning sets. --- 173,226 ---- ! PL/Tcl functions can return a record containing multiple output ! parameters. The function's Tcl code should return a list of ! key-value pairs matching the output parameters. ! ! ! 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'; ! ! ! ! ! Sets can be returned as a table type. The Tcl code should successively ! call return_next with an argument consisting of a Tcl ! list of key-value pairs. ! ! ! CREATE OR REPLACE FUNCTION squared_srf(int,int) RETURNS TABLE (x int, y int) AS $$ ! for {set i $1} {$i < $2} {incr i} { ! return_next [list x $i y [expr {$i * $i}]] ! } ! $$ LANGUAGE 'pltcl'; ! ! ! ! ! Any columns that are defined in the composite return type but absent from ! a list of key-value pairs passed to return_next are implicitly ! null in the corresponding row. PL/Tcl will generate a Tcl error when a ! column name in the key-value list is not one of the defined columns. ! ! ! ! Similarly, functions can be defined as returning SETOF ! with a user-defined data type. ! ! ! ! PL/Tcl functions can also use return_next to return a set of ! a scalar data type. ! ! ! CREATE OR REPLACE FUNCTION sequence(int,int) RETURNS SETOF int AS $$ ! for {set i $1} {$i < $2} {incr i} { ! return_next $i ! } ! $$ language 'pltcl'; ! *************** $$ LANGUAGE pltcl; *** 197,204 **** displayed by a SELECT statement). Conversely, the return command will accept any string that is acceptable input format for ! the function's declared return type. So, within the PL/Tcl function, ! all values are just text strings. --- 243,252 ---- displayed by a SELECT statement). Conversely, the return command will accept any string that is acceptable input format for ! the function's declared return type(s). Likewise when producing a ! set using return_next, values are converted to their ! native database data types. (A Tcl error is generated whenever this ! conversion fails.) diff --git a/src/pl/tcl/expected/pltcl_queries.out b/src/pl/tcl/expected/pltcl_queries.out index 6cb1fdb..05382e5 100644 *** a/src/pl/tcl/expected/pltcl_queries.out --- b/src/pl/tcl/expected/pltcl_queries.out *************** select tcl_lastoid('t2') > 0; *** 303,305 **** --- 303,366 ---- t (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 an 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 an 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" diff --git a/src/pl/tcl/expected/pltcl_setup.out b/src/pl/tcl/expected/pltcl_setup.out index e65e9e3..ed99d9b 100644 *** a/src/pl/tcl/expected/pltcl_setup.out --- b/src/pl/tcl/expected/pltcl_setup.out *************** NOTICE: tclsnitch: ddl_command_start DR *** 555,560 **** --- 555,573 ---- NOTICE: tclsnitch: ddl_command_end DROP TABLE drop event trigger tcl_a_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 create function tcl_error_handling_test() returns text as $$ global errorCode diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 9d72f47..9f04bd5 100644 *** a/src/pl/tcl/pltcl.c --- b/src/pl/tcl/pltcl.c *************** *** 21,26 **** --- 21,27 ---- #include "commands/trigger.h" #include "executor/spi.h" #include "fmgr.h" + #include "funcapi.h" #include "mb/pg_wchar.h" #include "miscadmin.h" #include "nodes/makefuncs.h" *************** typedef struct pltcl_interp_desc *** 123,128 **** --- 124,132 ---- * 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 * 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,142 **** --- 141,148 ---- pltcl_interp_desc *interp_desc; /* interpreter to use */ FmgrInfo result_in_func; /* input function for fn's result type */ 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 */ /* these arrays have nargs entries: */ FmgrInfo *arg_out_func; /* output fns for arg types */ *************** typedef struct pltcl_proc_ptr *** 189,194 **** --- 195,226 ---- /********************************************************************** + * 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 **********************************************************************/ static bool pltcl_pm_init_done = false; *************** static Tcl_Interp *pltcl_hold_interp = N *** 196,204 **** static HTAB *pltcl_interp_htab = NULL; static HTAB *pltcl_proc_htab = NULL; ! /* these are saved and restored by pltcl_handler */ ! static FunctionCallInfo pltcl_current_fcinfo = NULL; ! static pltcl_proc_desc *pltcl_current_prodesc = NULL; /********************************************************************** * Lookup table for SQLSTATE condition names --- 228,235 ---- static HTAB *pltcl_interp_htab = NULL; static HTAB *pltcl_proc_htab = NULL; ! /* this is saved and restored by pltcl_handler */ ! static pltcl_call_state *pltcl_current_call_state = NULL; /********************************************************************** * Lookup table for SQLSTATE condition names *************** static void pltcl_init_load_unknown(Tcl_ *** 225,234 **** static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted); ! static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted); ! ! static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted); ! static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted); static void throw_tcl_error(Tcl_Interp *interp, const char *proname); --- 256,267 ---- static Datum pltcl_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, pltcl_call_state *call_state, ! 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 int pltcl_argisnull(ClientData cd *** 246,252 **** int objc, Tcl_Obj *const objv[]); static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); ! static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int pltcl_process_SPI_result(Tcl_Interp *interp, --- 279,286 ---- int objc, Tcl_Obj *const objv[]); static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, 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, int objc, Tcl_Obj *const objv[]); static int pltcl_process_SPI_result(Tcl_Interp *interp, *************** static int pltcl_SPI_lastoid(ClientData *** 265,270 **** --- 299,308 ---- static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname, uint64 tupno, 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); /* *************** pltcl_init_interp(pltcl_interp_desc *int *** 432,438 **** pltcl_argisnull, NULL, NULL); Tcl_CreateObjCommand(interp, "return_null", pltcl_returnnull, NULL, NULL); ! Tcl_CreateObjCommand(interp, "spi_exec", pltcl_SPI_execute, NULL, NULL); Tcl_CreateObjCommand(interp, "spi_prepare", --- 470,477 ---- pltcl_argisnull, NULL, NULL); Tcl_CreateObjCommand(interp, "return_null", pltcl_returnnull, NULL, NULL); ! Tcl_CreateObjCommand(interp, "return_next", ! pltcl_returnnext, NULL, NULL); Tcl_CreateObjCommand(interp, "spi_exec", pltcl_SPI_execute, NULL, NULL); Tcl_CreateObjCommand(interp, "spi_prepare", *************** pltclu_call_handler(PG_FUNCTION_ARGS) *** 625,653 **** } static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) { Datum retval; ! FunctionCallInfo save_fcinfo; ! pltcl_proc_desc *save_prodesc; ! pltcl_proc_desc *this_prodesc; /* ! * Ensure that static pointers are saved/restored properly */ ! save_fcinfo = pltcl_current_fcinfo; ! save_prodesc = pltcl_current_prodesc; /* ! * Reset pltcl_current_prodesc 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. */ ! pltcl_current_prodesc = NULL; PG_TRY(); { --- 664,696 ---- } + /********************************************************************** + * pltcl_handler() - Handler for function and trigger calls, for + * both trusted and untrusted interpreters. + **********************************************************************/ static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) { Datum retval; ! pltcl_call_state current_call_state; ! pltcl_call_state *save_call_state; /* ! * 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. */ ! memset(¤t_call_state, 0, sizeof(current_call_state)); /* ! * Ensure that static pointer is saved/restored properly */ ! save_call_state = pltcl_current_call_state; ! pltcl_current_call_state = ¤t_call_state; PG_TRY(); { *************** pltcl_handler(PG_FUNCTION_ARGS, bool plt *** 657,703 **** */ if (CALLED_AS_TRIGGER(fcinfo)) { ! pltcl_current_fcinfo = NULL; ! retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted)); } else if (CALLED_AS_EVENT_TRIGGER(fcinfo)) { ! pltcl_current_fcinfo = NULL; ! pltcl_event_trigger_handler(fcinfo, pltrusted); retval = (Datum) 0; } else { ! pltcl_current_fcinfo = fcinfo; ! retval = pltcl_func_handler(fcinfo, pltrusted); } } PG_CATCH(); { ! /* Restore globals, then clean up the prodesc refcount if any */ ! this_prodesc = pltcl_current_prodesc; ! pltcl_current_fcinfo = save_fcinfo; ! pltcl_current_prodesc = save_prodesc; ! if (this_prodesc != NULL) { ! Assert(this_prodesc->fn_refcount > 0); ! if (--this_prodesc->fn_refcount == 0) ! MemoryContextDelete(this_prodesc->fn_cxt); } PG_RE_THROW(); } PG_END_TRY(); ! /* Restore globals, then clean up the prodesc refcount if any */ /* (We're being paranoid in case an error is thrown in context deletion) */ ! this_prodesc = pltcl_current_prodesc; ! pltcl_current_fcinfo = save_fcinfo; ! pltcl_current_prodesc = save_prodesc; ! if (this_prodesc != NULL) { ! Assert(this_prodesc->fn_refcount > 0); ! if (--this_prodesc->fn_refcount == 0) ! MemoryContextDelete(this_prodesc->fn_cxt); } return retval; --- 700,745 ---- */ if (CALLED_AS_TRIGGER(fcinfo)) { ! /* invoke the trigger handler */ ! retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, ! ¤t_call_state, ! pltrusted)); } else if (CALLED_AS_EVENT_TRIGGER(fcinfo)) { ! /* invoke the event trigger handler */ ! pltcl_event_trigger_handler(fcinfo, ¤t_call_state, pltrusted); retval = (Datum) 0; } else { ! /* invoke the regular function handler */ ! current_call_state.fcinfo = fcinfo; ! retval = pltcl_func_handler(fcinfo, ¤t_call_state, pltrusted); } } PG_CATCH(); { ! /* Restore static pointer, then clean up the prodesc refcount if any */ ! pltcl_current_call_state = save_call_state; ! if (current_call_state.prodesc != NULL) { ! Assert(current_call_state.prodesc->fn_refcount > 0); ! if (--current_call_state.prodesc->fn_refcount == 0) ! MemoryContextDelete(current_call_state.prodesc->fn_cxt); } PG_RE_THROW(); } PG_END_TRY(); ! /* Restore static pointer, then clean up the prodesc refcount if any */ /* (We're being paranoid in case an error is thrown in context deletion) */ ! pltcl_current_call_state = save_call_state; ! if (current_call_state.prodesc != NULL) { ! Assert(current_call_state.prodesc->fn_refcount > 0); ! if (--current_call_state.prodesc->fn_refcount == 0) ! MemoryContextDelete(current_call_state.prodesc->fn_cxt); } return retval; *************** pltcl_handler(PG_FUNCTION_ARGS, bool plt *** 708,714 **** * pltcl_func_handler() - Handler for regular function calls **********************************************************************/ static Datum ! pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; --- 750,757 ---- * pltcl_func_handler() - Handler for regular function calls **********************************************************************/ static Datum ! pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, ! bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 725,735 **** prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, false, pltrusted); ! pltcl_current_prodesc = prodesc; prodesc->fn_refcount++; interp = prodesc->interp_desc->interp; /************************************************************ * Create the tcl command to call the internal * proc in the Tcl interpreter --- 768,799 ---- prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, false, pltrusted); ! call_state->prodesc = prodesc; prodesc->fn_refcount++; 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 * proc in the Tcl interpreter *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 838,848 **** if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); ! if (fcinfo->isnull) retval = InputFunctionCall(&prodesc->result_in_func, NULL, prodesc->result_typioparam, -1); else retval = InputFunctionCall(&prodesc->result_in_func, utf_u2e(Tcl_GetStringResult(interp)), --- 902,973 ---- if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); ! 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, NULL, prodesc->result_typioparam, -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 retval = InputFunctionCall(&prodesc->result_in_func, utf_u2e(Tcl_GetStringResult(interp)), *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 857,863 **** * pltcl_trigger_handler() - Handler for trigger calls **********************************************************************/ static HeapTuple ! pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; --- 982,989 ---- * pltcl_trigger_handler() - Handler for trigger calls **********************************************************************/ static HeapTuple ! pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, ! bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 887,893 **** false, /* not an event trigger */ pltrusted); ! pltcl_current_prodesc = prodesc; prodesc->fn_refcount++; interp = prodesc->interp_desc->interp; --- 1013,1019 ---- false, /* not an event trigger */ pltrusted); ! call_state->prodesc = prodesc; prodesc->fn_refcount++; interp = prodesc->interp_desc->interp; *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 1188,1194 **** * pltcl_event_trigger_handler() - Handler for event trigger calls **********************************************************************/ static void ! pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; --- 1314,1321 ---- * pltcl_event_trigger_handler() - Handler for event trigger calls **********************************************************************/ static void ! pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, ! bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; *************** pltcl_event_trigger_handler(PG_FUNCTION_ *** 1204,1210 **** prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, true, pltrusted); ! pltcl_current_prodesc = prodesc; prodesc->fn_refcount++; interp = prodesc->interp_desc->interp; --- 1331,1337 ---- prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, true, pltrusted); ! call_state->prodesc = prodesc; prodesc->fn_refcount++; interp = prodesc->interp_desc->interp; *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1408,1417 **** procStruct->prorettype); typeStruct = (Form_pg_type) GETSTRUCT(typeTup); ! /* Disallow pseudotype result, except VOID */ if (typeStruct->typtype == TYPTYPE_PSEUDO) { ! if (procStruct->prorettype == VOIDOID) /* okay */ ; else if (procStruct->prorettype == TRIGGEROID || procStruct->prorettype == EVTTRIGGEROID) --- 1535,1545 ---- procStruct->prorettype); typeStruct = (Form_pg_type) GETSTRUCT(typeTup); ! /* Disallow pseudotype result, except VOID and RECORD */ if (typeStruct->typtype == TYPTYPE_PSEUDO) { ! if (procStruct->prorettype == VOIDOID || ! procStruct->prorettype == RECORDOID) /* okay */ ; else if (procStruct->prorettype == TRIGGEROID || procStruct->prorettype == EVTTRIGGEROID) *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1425,1440 **** 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, &(prodesc->result_in_func), proc_cxt); prodesc->result_typioparam = getTypeIOParam(typeTup); ReleaseSysCache(typeTup); } --- 1553,1567 ---- format_type_be(procStruct->prorettype)))); } fmgr_info_cxt(typeStruct->typinput, &(prodesc->result_in_func), proc_cxt); prodesc->result_typioparam = getTypeIOParam(typeTup); + prodesc->fn_retisset = procStruct->proretset; + prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID || + typeStruct->typtype == TYPTYPE_COMPOSITE); + ReleaseSysCache(typeTup); } *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1933,1939 **** int objc, Tcl_Obj *const objv[]) { int argno; ! FunctionCallInfo fcinfo = pltcl_current_fcinfo; /************************************************************ * Check call syntax --- 2060,2066 ---- int objc, Tcl_Obj *const objv[]) { int argno; ! FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo; /************************************************************ * Check call syntax *************** static int *** 1986,1992 **** pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { ! FunctionCallInfo fcinfo = pltcl_current_fcinfo; /************************************************************ * Check call syntax --- 2113,2119 ---- pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { ! FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo; /************************************************************ * Check call syntax *************** pltcl_returnnull(ClientData cdata, Tcl_I *** 2017,2022 **** --- 2144,2221 ---- } + /********************************************************************** + * 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; + + /* + * 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); + + if (prodesc->fn_retistuple) + { + Tcl_Obj **rowObjv; + int rowObjc; + HeapTuple tuple; + + /* result should be a list, so break it down */ + if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR) + return TCL_ERROR; + tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc, call_state); + tuplestore_puttuple(call_state->tuple_store, tuple); + } + else + { + Datum retval; + bool isNull = false; + + UTF_BEGIN; + retval = InputFunctionCall(&prodesc->result_in_func, + UTF_U2E((char *) Tcl_GetString(objv[1])), + prodesc->result_typioparam, + -1); + UTF_END; + tuplestore_putvalues(call_state->tuple_store, call_state->ret_tupdesc, + &retval, &isNull); + } + + return TCL_OK; + } + + /*---------- * Support for running SPI operations inside subtransactions * *************** pltcl_SPI_execute(ClientData cdata, Tcl_ *** 2183,2189 **** { UTF_BEGIN; spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])), ! pltcl_current_prodesc->fn_readonly, count); UTF_END; my_rc = pltcl_process_SPI_result(interp, --- 2382,2388 ---- { UTF_BEGIN; spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])), ! pltcl_current_call_state->prodesc->fn_readonly, count); UTF_END; my_rc = pltcl_process_SPI_result(interp, *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2433,2439 **** * Insert a hashtable entry for the plan and return * the key to the caller ************************************************************/ ! query_hash = &pltcl_current_prodesc->interp_desc->query_hash; hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew); Tcl_SetHashValue(hashent, (ClientData) qdesc); --- 2632,2638 ---- * Insert a hashtable entry for the plan and return * the key to the caller ************************************************************/ ! query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash; hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew); Tcl_SetHashValue(hashent, (ClientData) qdesc); *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2522,2528 **** return TCL_ERROR; } ! query_hash = &pltcl_current_prodesc->interp_desc->query_hash; hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i])); if (hashent == NULL) --- 2721,2727 ---- return TCL_ERROR; } ! query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash; hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i])); if (hashent == NULL) *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2637,2643 **** * 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, --- 2836,2843 ---- * Execute the plan ************************************************************/ spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls, ! pltcl_current_call_state->prodesc->fn_readonly, ! count); my_rc = pltcl_process_SPI_result(interp, arrayname, *************** pltcl_build_tuple_argument(HeapTuple tup *** 2822,2824 **** --- 3022,3106 ---- return retobj; } + + /********************************************************************** + * pltcl_build_tuple_result() - Build a tuple of function's result rowtype + * from a Tcl list of column names and values + **********************************************************************/ + static HeapTuple + pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc, + pltcl_call_state *call_state) + { + HeapTuple tup; + char **values; + int i; + + if (kvObjc & 1) + ereport(ERROR, + (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), + errmsg("column name/value list must have an even number of elements"))); + + values = (char **) palloc0(call_state->ret_tupdesc->natts * sizeof(char *)); + + for (i = 0; i < kvObjc; i += 2) + { + char *fieldName = 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))); + + UTF_BEGIN; + values[attn - 1] = UTF_E2U(Tcl_GetString(kvObjv[i + 1])); + UTF_END; + } + + tup = BuildTupleFromCStrings(call_state->attinmeta, values); + pfree(values); + return tup; + } + + /********************************************************************** + * 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); + } diff --git a/src/pl/tcl/sql/pltcl_queries.sql b/src/pl/tcl/sql/pltcl_queries.sql index a0a9619..0ebfe65 100644 *** a/src/pl/tcl/sql/pltcl_queries.sql --- b/src/pl/tcl/sql/pltcl_queries.sql *************** create temp table t1 (f1 int); *** 97,99 **** --- 97,132 ---- select tcl_lastoid('t1'); create temp table t2 (f1 int) with oids; 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(); diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql index 8df65a5..58f38d5 100644 *** a/src/pl/tcl/sql/pltcl_setup.sql --- b/src/pl/tcl/sql/pltcl_setup.sql *************** drop table foo; *** 596,601 **** --- 596,617 ---- drop event trigger tcl_a_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 create function tcl_error_handling_test() returns text as $$