pltcl_srf_composite2.diff

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);