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 @@ -173,8 +173,54 @@ $$ LANGUAGE pltcl; - There is currently no support for returning a composite-type - result value, nor for returning sets. + 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'; + @@ -197,8 +243,10 @@ $$ LANGUAGE pltcl; 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. + 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..1d4cbb3 100644 --- a/src/pl/tcl/expected/pltcl_queries.out +++ b/src/pl/tcl/expected/pltcl_queries.out @@ -303,3 +303,63 @@ select tcl_lastoid('t2') > 0; t (1 row) +-- test compound return +select * from tcl_test_cube_squared(5); + squared | cubed +---------+------- + 25 | 125 +(1 row) + +CREATE FUNCTION bad_record(OUT a text , OUT b text) AS $$return [list a]$$ LANGUAGE pltcl; +SELECT bad_record(); +ERROR: list must have even number of elements +CREATE FUNCTION bad_field(OUT a text , OUT b text) AS $$return [list cow 1 a 2 b 3]$$ LANGUAGE pltcl; +SELECT bad_field(); +ERROR: Tcl list contains nonexistent column "cow" +CREATE OR REPLACE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl; +SELECT tcl_error(); +ERROR: missing close-brace +-- 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 OR REPLACE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl; +select non_srf(); +ERROR: cannot use return_next in a non-set-returning function +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: 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 cow 1 a 2 b 3] +$$ LANGUAGE pltcl; +SELECT bad_field_srf(); +ERROR: Tcl list contains nonexistent column "cow" diff --git a/src/pl/tcl/expected/pltcl_setup.out b/src/pl/tcl/expected/pltcl_setup.out index e65e9e3..5332187 100644 --- a/src/pl/tcl/expected/pltcl_setup.out +++ b/src/pl/tcl/expected/pltcl_setup.out @@ -569,6 +569,19 @@ create function tcl_error_handling_test() returns text as $$ return "no error" } $$ language pltcl; +CREATE OR REPLACE 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 OR REPLACE 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 OR REPLACE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$ + for {set i $1} {$i < $2} {incr i} { + return_next $i + } +$$ language 'pltcl'; select tcl_error_handling_test(); tcl_error_handling_test ----------------------------------------------- diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index d236890..00f5f59 100644 --- a/src/pl/tcl/pltcl.c +++ b/src/pl/tcl/pltcl.c @@ -32,6 +32,7 @@ #include "utils/rel.h" #include "utils/syscache.h" #include "utils/typcache.h" +#include "funcapi.h" PG_MODULE_MAGIC; @@ -141,6 +142,18 @@ typedef struct pltcl_proc_desc /* these arrays have nargs entries: */ FmgrInfo *arg_out_func; /* output fns for arg types */ bool *arg_is_rowtype; /* is each arg composite? */ + + /* Information for SRFs and returning composite types */ + bool fn_retistuple; /* true, if function returns tuple */ + bool fn_retisset; /* true, if function returns a set */ + int natts; + Oid result_oid; /* Oid of result type */ + TupleDesc ret_tupdesc; + Tuplestorestate *tuple_store; /* SRFs accumulate result here */ + AttInMetadata *attinmeta; /* Metadata for return type */ + MemoryContext tuple_store_cxt; + ResourceOwner tuple_store_owner; + ReturnSetInfo *rsi; } pltcl_proc_desc; @@ -236,6 +249,9 @@ static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid, bool is_event_trigger, bool pltrusted); +static void pltcl_pg_returnnext(Tcl_Interp *interp, int rowObjc, + Tcl_Obj **rowObjv); + static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata); @@ -246,6 +262,8 @@ static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, 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[]); @@ -266,7 +284,6 @@ 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); - /* * Hack to override Tcl's builtin Notifier subsystem. This prevents the * backend from becoming multithreaded, which breaks all sorts of things. @@ -323,6 +340,71 @@ pltcl_WaitForEvent(CONST86 Tcl_Time *timePtr) return 0; } +static HeapTuple +pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc, pltcl_proc_desc *prodesc) +{ + HeapTuple tup; + char **values; + int i; + + if (kvObjc & 1) + ereport(ERROR, + (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), + errmsg("list must have even number of elements"))); + + values = (char **) palloc0(prodesc->natts * sizeof(char *)); + + for (i = 0; i < kvObjc; i += 2) + { + char *fieldName = Tcl_GetString(kvObjv[i]); + int attn = SPI_fnumber(prodesc->ret_tupdesc, fieldName); + + if (attn <= 0 || prodesc->ret_tupdesc->attrs[attn - 1]->attisdropped) + ereport(ERROR, + (errcode(ERRCODE_UNDEFINED_COLUMN), + errmsg("Tcl list contains nonexistent column \"%s\"", + fieldName))); + + UTF_BEGIN; + values[attn - 1] = UTF_E2U(Tcl_GetString(kvObjv[i + 1])); + UTF_END; + } + + tup = BuildTupleFromCStrings(prodesc->attinmeta, values); + pfree(values); + return tup; +} + +/********************************************************************** + * pltcl_reset_state() - reset function's runtime state + * + * This is called on function and trigger entry + * (pltcl_func_handler and pltcl_trigger_handler) to clear + * any previous results. + * + * rsi is present if it's a function but not if it's a trigger. + **********************************************************************/ +static void +pltcl_reset_state(pltcl_proc_desc *prodesc, ReturnSetInfo *rsi) +{ + prodesc->ret_tupdesc = NULL; + prodesc->tuple_store = NULL; + prodesc->attinmeta = NULL; + prodesc->natts = 0; + + if (rsi) + { + prodesc->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory; + prodesc->tuple_store_owner = CurrentResourceOwner; + } + else + { + prodesc->tuple_store_cxt = NULL; + prodesc->tuple_store_owner = NULL; + } + + prodesc->rsi = rsi; +} /* * _PG_init() - library load-time initialization @@ -432,7 +514,8 @@ pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted) 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", @@ -625,6 +708,10 @@ pltclu_call_handler(PG_FUNCTION_ARGS) } +/********************************************************************** + * pltcl_handler() - Handler for function and trigger calls, for + * both trusted and untrusted interpreters. + **********************************************************************/ static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) { @@ -657,17 +744,20 @@ pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) */ if (CALLED_AS_TRIGGER(fcinfo)) { + /* invoke the trigger handler */ pltcl_current_fcinfo = NULL; retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted)); } else if (CALLED_AS_EVENT_TRIGGER(fcinfo)) { + /* invoke the event trigger handler */ pltcl_current_fcinfo = NULL; pltcl_event_trigger_handler(fcinfo, pltrusted); retval = (Datum) 0; } else { + /* invoke the trigger handler */ pltcl_current_fcinfo = fcinfo; retval = pltcl_func_handler(fcinfo, pltrusted); } @@ -725,11 +815,18 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted) prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, false, pltrusted); + /* + * Store current proc description globally. This should be redone using + * clientdata-type structures to allow threading. + */ pltcl_current_prodesc = prodesc; prodesc->fn_refcount++; interp = prodesc->interp_desc->interp; + /* Reset essential function runtime to a known state. */ + pltcl_reset_state(prodesc, (ReturnSetInfo *) fcinfo->resultinfo); + /************************************************************ * Create the tcl command to call the internal * proc in the Tcl interpreter @@ -843,6 +940,63 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted) NULL, prodesc->result_typioparam, -1); + else if (prodesc->fn_retisset) + { + ReturnSetInfo *rsi = prodesc->rsi; + + 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"))); + + rsi->returnMode = SFRM_Materialize; + + /* If we produced any tuples, send back the result */ + if (prodesc->tuple_store) + { + rsi->setResult = prodesc->tuple_store; + if (prodesc->ret_tupdesc) + { + MemoryContext oldcxt; + + oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt); + rsi->setDesc = CreateTupleDescCopy(prodesc->ret_tupdesc); + MemoryContextSwitchTo(oldcxt); + } + } + retval = (Datum) 0; + fcinfo->isnull = true; + } + else if (prodesc->fn_retistuple) + { + TupleDesc td; + HeapTuple tup; + Tcl_Obj *resultObj; + Tcl_Obj **resultObjv; + int resultObjc; + + 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"))); + } + + resultObj = Tcl_GetObjResult(interp); + if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR) + throw_tcl_error(interp, prodesc->user_proname); + + Assert(!prodesc->ret_tupdesc); + Assert(!prodesc->attinmeta); + prodesc->ret_tupdesc = td; + prodesc->natts = td->natts; + prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc); + + tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc, prodesc); + retval = HeapTupleGetDatum(tup); + } else retval = InputFunctionCall(&prodesc->result_in_func, utf_u2e(Tcl_GetStringResult(interp)), @@ -891,16 +1045,16 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted) prodesc->fn_refcount++; interp = prodesc->interp_desc->interp; - tupdesc = trigdata->tg_relation->rd_att; + pltcl_reset_state(prodesc, NULL); + /************************************************************ * Create the tcl command to call the internal * proc in the interpreter ************************************************************/ tcl_cmd = Tcl_NewObj(); Tcl_IncrRefCount(tcl_cmd); - PG_TRY(); { /* The procedure name (note this is all ASCII, so no utf_e2u) */ @@ -1258,6 +1412,52 @@ throw_tcl_error(Tcl_Interp *interp, const char *proname) econtext, proname))); } +static void +pltcl_init_tuple_store(pltcl_proc_desc *prodesc) +{ + ReturnSetInfo *rsi = prodesc->rsi; + MemoryContext oldcxt; + ResourceOwner oldowner; + + /* + * Check caller can handle a set result in the way we want. This should + * have already been checked, but might as well play it safe. + */ + 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"))); + + Assert(rsi->expectedDesc); + Assert(!prodesc->tuple_store); + Assert(!prodesc->attinmeta); + + /* + * Switch to the right memory context and resource owner for storing the + * tuplestore for return set. 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 resource owner. + */ + prodesc->ret_tupdesc = rsi->expectedDesc; + prodesc->natts = prodesc->ret_tupdesc->natts; + + oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt); + oldowner = CurrentResourceOwner; + CurrentResourceOwner = prodesc->tuple_store_owner; + + prodesc->tuple_store = + tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random, + false, work_mem); + + prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc); + + CurrentResourceOwner = oldowner; + MemoryContextSwitchTo(oldcxt); + +} + /********************************************************************** * compile_pltcl_function - compile (or hopefully just look up) function @@ -1341,6 +1541,7 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid, int i; int tcl_rc; MemoryContext oldcontext; + FunctionCallInfo fcinfo = pltcl_current_fcinfo; /************************************************************ * Build our internal proc name from the function's Oid. Append @@ -1400,6 +1601,13 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid, ************************************************************/ if (!is_trigger && !is_event_trigger) { + prodesc->rsi = (ReturnSetInfo *) fcinfo->resultinfo; + if (prodesc->rsi) + { + prodesc->tuple_store_cxt = prodesc->rsi->econtext->ecxt_per_query_memory; + prodesc->tuple_store_owner = CurrentResourceOwner; + } + typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(procStruct->prorettype)); @@ -1411,7 +1619,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid, /* Disallow pseudotype result, except VOID */ if (typeStruct->typtype == TYPTYPE_PSEUDO) { - if (procStruct->prorettype == VOIDOID) + if (procStruct->prorettype == VOIDOID || + procStruct->prorettype == RECORDOID) /* okay */ ; else if (procStruct->prorettype == TRIGGEROID || procStruct->prorettype == EVTTRIGGEROID) @@ -1425,10 +1634,10 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid, 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"))); + prodesc->fn_retisset = procStruct->proretset; + prodesc->result_oid = procStruct->prorettype; + prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID || + typeStruct->typtype == TYPTYPE_COMPOSITE); fmgr_info_cxt(typeStruct->typinput, &(prodesc->result_in_func), @@ -2016,6 +2225,99 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, return TCL_RETURN; } +/********************************************************************** + * pltcl_pg_returnnext() - Queue a row of Tcl key-value pairs into the + * function's tuple_store + **********************************************************************/ +static void +pltcl_pg_returnnext(Tcl_Interp *interp, int rowObjc, Tcl_Obj **rowObjv) +{ + pltcl_proc_desc *prodesc = pltcl_current_prodesc; + + if (!prodesc->fn_retisset) + ereport(ERROR, + (errcode(ERRCODE_SYNTAX_ERROR), + errmsg("cannot use return_next in a non-SETOF function"))); + + if (prodesc->tuple_store == NULL) + pltcl_init_tuple_store(prodesc); + + if (prodesc->fn_retistuple) + { + HeapTuple tuple; + + tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc, prodesc); + tuplestore_puttuple(prodesc->tuple_store, tuple); + } + else + { + Datum retval; + bool isNull = false; + + UTF_BEGIN; + retval = InputFunctionCall(&prodesc->result_in_func, + UTF_U2E((char *) Tcl_GetString(rowObjv[0])), + prodesc->result_typioparam, + -1); + UTF_END; + tuplestore_putvalues(prodesc->tuple_store, prodesc->ret_tupdesc, &retval, &isNull); + } +} + +/********************************************************************** + * pltcl_returnnext() - Tcl-callable command take a list of key-value + * pairs and store in the tuple_store + * for sending as a result when the + * function is complete. + **********************************************************************/ +static int +pltcl_returnnext(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj * const objv[]) +{ + FunctionCallInfo fcinfo = pltcl_current_fcinfo; + Tcl_Obj **rowObjv; + int rowObjc; + pltcl_proc_desc *prodesc = pltcl_current_prodesc; + + /* + * Check that we're called as a normal function + */ + if (fcinfo == NULL) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("return_next cannot be used in triggers", -1)); + return TCL_ERROR; + } + + /* + * Check call syntax + */ + if (objc != 2) + { + Tcl_WrongNumArgs(interp, 1, objv, "list"); + return TCL_ERROR; + } + + if (!prodesc->fn_retisset) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot use return_next in a non-set-returning function", -1)); + return TCL_ERROR; + } + + if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR) + return TCL_ERROR; + + if ((rowObjc != 1) && (rowObjc & 1)) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("list must have one or an even number of elements", -1)); + return TCL_ERROR; + } + + pltcl_pg_returnnext(interp, rowObjc, rowObjv); + return TCL_OK; +} /*---------- * Support for running SPI operations inside subtransactions @@ -2138,7 +2440,11 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, i = 1; while (i < objc) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", + /* + * Don't store an error message in the interpreter. It isn't an error + * if it doesn't find an option. + */ + if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &optIndex) != TCL_OK) break; @@ -2484,7 +2790,11 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, i = 1; while (i < objc) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", + /* + * Don't store an error message in the interpreter. It isn't an error + * if it doesn't find an option. + */ + if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &optIndex) != TCL_OK) break; @@ -2667,6 +2977,15 @@ static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + /* + * Check call syntax + */ + if (objc != 1) + { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(SPI_lastoid)); return TCL_OK; } diff --git a/src/pl/tcl/sql/pltcl_queries.sql b/src/pl/tcl/sql/pltcl_queries.sql index a0a9619..13f7cd3 100644 --- a/src/pl/tcl/sql/pltcl_queries.sql +++ b/src/pl/tcl/sql/pltcl_queries.sql @@ -97,3 +97,36 @@ create temp table t1 (f1 int); select tcl_lastoid('t1'); create temp table t2 (f1 int) with oids; select tcl_lastoid('t2') > 0; + +-- test compound return +select * from tcl_test_cube_squared(5); + +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 cow 1 a 2 b 3]$$ LANGUAGE pltcl; +SELECT bad_field(); + +CREATE OR REPLACE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl; +SELECT tcl_error(); + +-- 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 OR REPLACE 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 cow 1 a 2 b 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..93a479e 100644 --- a/src/pl/tcl/sql/pltcl_setup.sql +++ b/src/pl/tcl/sql/pltcl_setup.sql @@ -612,6 +612,22 @@ create function tcl_error_handling_test() returns text as $$ } $$ language pltcl; +CREATE OR REPLACE 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 OR REPLACE 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 OR REPLACE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$ + for {set i $1} {$i < $2} {incr i} { + return_next $i + } +$$ language 'pltcl'; + select tcl_error_handling_test(); create temp table foo(f1 int);