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
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..7a7b029 100644
--- a/src/pl/tcl/expected/pltcl_queries.out
+++ b/src/pl/tcl/expected/pltcl_queries.out
@@ -303,3 +303,44 @@ 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 cow]$$
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)
+
+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
+-- test setof returns
+select * from tcl_test_sequence(0,5) as a;
+ a
+---
+ 0
+ 1
+ 2
+ 3
+ 4
+(5 rows)
+
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/expected/pltcl_srf_composite.out.diff
b/src/pl/tcl/expected/pltcl_srf_composite.out.diff
new file mode 100644
index 0000000..e69de29
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
