Hi
I checked this code, and it looks well
0. there are not any reason why we would not to implement this feature -
more, the implementation is simple.
1. there was not problem with patching, compilation
2. the original patch is missing new expected result for regress tests,
fixed in attached patch
3. all regress tests passed
4. the tests and docs is enough for this purpose
I'll mark this patch as ready for commit
Regards
Pavel
2016-10-13 0:06 GMT+02:00 Jim Nasby <jim.na...@bluetreble.com>:
> Attached is a patch that adds support for SRFs and returning composites
> from pl/tcl. This work was sponsored by Flight Aware.
> --
> Jim Nasby, Data Architect, Blue Treble Consulting, Austin TX
> Experts in Analytics, Data Architecture and PostgreSQL
> Data in Trouble? Get it in Treble! http://BlueTreble.com
> 855-TREBLE2 (855-873-2532) mobile: 512-569-9461
>
>
> --
> Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
> To make changes to your subscription:
> http://www.postgresql.org/mailpref/pgsql-hackers
>
>
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;
</para>
<para>
- 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.
+
+<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>
+ Sets can be returned as a table type. The Tcl code should successively
+ call <literal>return_next</literal> with an argument consisting of a Tcl
+ list of key-value pairs.
+
+<programlisting>
+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';
+</programlisting>
+ </para>
+
+ <para>
+ Any columns that are defined in the composite return type but absent from
+ a list of key-value pairs passed to <literal>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.
+ </para>
+
+ <para>
+ Similarly, functions can be defined as returning <literal>SETOF</literal>
+ with a user-defined data type.
+ </para>
+
+ <para>
+ PL/Tcl functions can also use <literal>return_next</> to return a set of
+ a scalar data type.
+
+<programlisting>
+CREATE OR REPLACE FUNCTION sequence(int,int) RETURNS SETOF int AS $$
+ for {set i $1} {$i < $2} {incr i} {
+ return_next $i
+ }
+$$ language 'pltcl';
+</programlisting>
</para>
<para>
@@ -197,8 +243,10 @@ $$ LANGUAGE pltcl;
displayed by a <command>SELECT</> statement). Conversely, the
<literal>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 <literal>return_next</>, values are converted to their
+ native database data types. (A Tcl error is generated whenever this
+ conversion fails.)
</para>
</sect1>
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);
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
