Re: Add support for SRF and returning composites to pl/tcl

Jim Nasby <Jim.Nasby@BlueTreble.com> writes:
> Attached is a patch that adds support for SRFs and returning composites
> from pl/tcl. This work was sponsored by Flight Aware.

I spent a fair amount of time whacking this around, because I did not
like the fact that you were using the pltcl_proc_desc structs for
call-local data.  That would fail nastily in a recursive function.
I ended up making a new struct to represent per-call data, which
allowed reducing the number of global pointers.

I got the code to a state that I liked (attached), and started reviewing
the docs, and then it occurred to me to wonder why you'd chosen to use
Tcl lists to represent composite output values.  The precedent established
by input argument handling is that composites are transformed to Tcl
arrays.  So shouldn't we use an array to represent a composite result,
too?

I wouldn't necessarily object to allowing either representation, though
I'm not sure how we'd distinguish between them.

            regards, tom lane

diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index 805cc89..1c185cb 100644
*** a/doc/src/sgml/pltcl.sgml
--- b/doc/src/sgml/pltcl.sgml
*************** $$ LANGUAGE pltcl;
*** 173,180 ****
      </para>

      <para>
!      There is currently no support for returning a composite-type
!      result value, nor for returning sets.
      </para>

      <para>
--- 173,226 ----
      </para>

      <para>
!      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>
*************** $$ LANGUAGE pltcl;
*** 197,204 ****
       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.
      </para>

     </sect1>
--- 243,252 ----
       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(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..05382e5 100644
*** a/src/pl/tcl/expected/pltcl_queries.out
--- b/src/pl/tcl/expected/pltcl_queries.out
*************** select tcl_lastoid('t2') > 0;
*** 303,305 ****
--- 303,366 ----
   t
  (1 row)

+ -- test some error cases
+ CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl;
+ SELECT tcl_error();
+ ERROR:  missing close-brace
+ CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ LANGUAGE pltcl;
+ SELECT bad_record();
+ ERROR:  column name/value list must have an even number of elements
+ CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 cow 3]$$ LANGUAGE pltcl;
+ SELECT bad_field();
+ ERROR:  column name/value list contains nonexistent column name "cow"
+ -- test compound return
+ select * from tcl_test_cube_squared(5);
+  squared | cubed
+ ---------+-------
+       25 |   125
+ (1 row)
+
+ -- test SRF
+ select * from tcl_test_squared_rows(0,5);
+  x | y
+ ---+----
+  0 |  0
+  1 |  1
+  2 |  4
+  3 |  9
+  4 | 16
+ (5 rows)
+
+ select * from tcl_test_sequence(0,5) as a;
+  a
+ ---
+  0
+  1
+  2
+  3
+  4
+ (5 rows)
+
+ select 1, tcl_test_sequence(0,5);
+  ?column? | tcl_test_sequence
+ ----------+-------------------
+         1 |                 0
+         1 |                 1
+         1 |                 2
+         1 |                 3
+         1 |                 4
+ (5 rows)
+
+ CREATE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl;
+ select non_srf();
+ ERROR:  return_next cannot be used in non-set-returning functions
+ CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
+ return_next [list a]
+ $$ LANGUAGE pltcl;
+ SELECT bad_record_srf();
+ ERROR:  column name/value list must have an even number of elements
+ CREATE FUNCTION bad_field_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
+ return_next [list a 1 b 2 cow 3]
+ $$ LANGUAGE pltcl;
+ SELECT bad_field_srf();
+ ERROR:  column name/value list contains nonexistent column name "cow"
diff --git a/src/pl/tcl/expected/pltcl_setup.out b/src/pl/tcl/expected/pltcl_setup.out
index e65e9e3..ed99d9b 100644
*** a/src/pl/tcl/expected/pltcl_setup.out
--- b/src/pl/tcl/expected/pltcl_setup.out
*************** NOTICE:  tclsnitch: ddl_command_start DR
*** 555,560 ****
--- 555,573 ----
  NOTICE:  tclsnitch: ddl_command_end DROP TABLE
  drop event trigger tcl_a_snitch;
  drop event trigger tcl_b_snitch;
+ CREATE FUNCTION tcl_test_cube_squared(in int, out squared int, out cubed int) AS $$
+     return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
+ $$ language pltcl;
+ CREATE FUNCTION tcl_test_squared_rows(int,int) RETURNS TABLE (x int, y int) AS $$
+     for {set i $1} {$i < $2} {incr i} {
+         return_next [list y [expr {$i * $i}] x $i]
+     }
+ $$ language pltcl;
+ CREATE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$
+     for {set i $1} {$i < $2} {incr i} {
+         return_next $i
+     }
+ $$ language pltcl;
  -- test use of errorCode in error handling
  create function tcl_error_handling_test() returns text as $$
      global errorCode
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 9d72f47..9f04bd5 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
***************
*** 21,26 ****
--- 21,27 ----
  #include "commands/trigger.h"
  #include "executor/spi.h"
  #include "fmgr.h"
+ #include "funcapi.h"
  #include "mb/pg_wchar.h"
  #include "miscadmin.h"
  #include "nodes/makefuncs.h"
*************** typedef struct pltcl_interp_desc
*** 123,128 ****
--- 124,132 ----
   * problem to manage its memory when we replace a proc definition.  We do
   * not clean up pltcl_proc_descs when a pg_proc row is deleted, only when
   * it is updated, and the same policy applies to Tcl's copy as well.)
+  *
+  * Note that the data in this struct is shared across all active calls;
+  * nothing except the fn_refcount should be changed by a call instance.
   **********************************************************************/
  typedef struct pltcl_proc_desc
  {
*************** typedef struct pltcl_proc_desc
*** 137,142 ****
--- 141,148 ----
      pltcl_interp_desc *interp_desc;        /* interpreter to use */
      FmgrInfo    result_in_func; /* input function for fn's result type */
      Oid            result_typioparam;        /* param to pass to same */
+     bool        fn_retisset;    /* true if function returns a set */
+     bool        fn_retistuple;    /* true if function returns composite */
      int            nargs;            /* number of arguments */
      /* these arrays have nargs entries: */
      FmgrInfo   *arg_out_func;    /* output fns for arg types */
*************** typedef struct pltcl_proc_ptr
*** 189,194 ****
--- 195,226 ----


  /**********************************************************************
+  * Per-call state
+  **********************************************************************/
+ typedef struct pltcl_call_state
+ {
+     /* Call info struct, or NULL in a trigger */
+     FunctionCallInfo fcinfo;
+
+     /* Function we're executing (NULL if not yet identified) */
+     pltcl_proc_desc *prodesc;
+
+     /*
+      * Information for SRFs and functions returning composite types.
+      * ret_tupdesc and attinmeta are set up if either fn_retistuple or
+      * fn_retisset, since even a scalar-returning SRF needs a tuplestore.
+      */
+     TupleDesc    ret_tupdesc;    /* return rowtype, if retistuple or retisset */
+     AttInMetadata *attinmeta;    /* metadata for building tuples of that type */
+
+     ReturnSetInfo *rsi;            /* passed-in ReturnSetInfo, if any */
+     Tuplestorestate *tuple_store;        /* SRFs accumulate result here */
+     MemoryContext tuple_store_cxt;        /* context and resowner for tuplestore */
+     ResourceOwner tuple_store_owner;
+ } pltcl_call_state;
+
+
+ /**********************************************************************
   * Global data
   **********************************************************************/
  static bool pltcl_pm_init_done = false;
*************** static Tcl_Interp *pltcl_hold_interp = N
*** 196,204 ****
  static HTAB *pltcl_interp_htab = NULL;
  static HTAB *pltcl_proc_htab = NULL;

! /* these are saved and restored by pltcl_handler */
! static FunctionCallInfo pltcl_current_fcinfo = NULL;
! static pltcl_proc_desc *pltcl_current_prodesc = NULL;

  /**********************************************************************
   * Lookup table for SQLSTATE condition names
--- 228,235 ----
  static HTAB *pltcl_interp_htab = NULL;
  static HTAB *pltcl_proc_htab = NULL;

! /* this is saved and restored by pltcl_handler */
! static pltcl_call_state *pltcl_current_call_state = NULL;

  /**********************************************************************
   * Lookup table for SQLSTATE condition names
*************** static void pltcl_init_load_unknown(Tcl_
*** 225,234 ****

  static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);

! static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted);
!
! static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted);
! static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted);

  static void throw_tcl_error(Tcl_Interp *interp, const char *proname);

--- 256,267 ----

  static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);

! static Datum pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
!                    bool pltrusted);
! static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
!                       bool pltrusted);
! static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
!                             bool pltrusted);

  static void throw_tcl_error(Tcl_Interp *interp, const char *proname);

*************** static int pltcl_argisnull(ClientData cd
*** 246,252 ****
                  int objc, Tcl_Obj *const objv[]);
  static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
                   int objc, Tcl_Obj *const objv[]);
!
  static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
                    int objc, Tcl_Obj *const objv[]);
  static int pltcl_process_SPI_result(Tcl_Interp *interp,
--- 279,286 ----
                  int objc, Tcl_Obj *const objv[]);
  static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
                   int objc, Tcl_Obj *const objv[]);
! static int pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
!                  int objc, Tcl_Obj *const objv[]);
  static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
                    int objc, Tcl_Obj *const objv[]);
  static int pltcl_process_SPI_result(Tcl_Interp *interp,
*************** static int pltcl_SPI_lastoid(ClientData
*** 265,270 ****
--- 299,308 ----
  static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname,
                         uint64 tupno, HeapTuple tuple, TupleDesc tupdesc);
  static Tcl_Obj *pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc);
+ static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp,
+                          Tcl_Obj **kvObjv, int kvObjc,
+                          pltcl_call_state *call_state);
+ static void pltcl_init_tuple_store(pltcl_call_state *call_state);


  /*
*************** pltcl_init_interp(pltcl_interp_desc *int
*** 432,438 ****
                           pltcl_argisnull, NULL, NULL);
      Tcl_CreateObjCommand(interp, "return_null",
                           pltcl_returnnull, NULL, NULL);
!
      Tcl_CreateObjCommand(interp, "spi_exec",
                           pltcl_SPI_execute, NULL, NULL);
      Tcl_CreateObjCommand(interp, "spi_prepare",
--- 470,477 ----
                           pltcl_argisnull, NULL, NULL);
      Tcl_CreateObjCommand(interp, "return_null",
                           pltcl_returnnull, NULL, NULL);
!     Tcl_CreateObjCommand(interp, "return_next",
!                          pltcl_returnnext, NULL, NULL);
      Tcl_CreateObjCommand(interp, "spi_exec",
                           pltcl_SPI_execute, NULL, NULL);
      Tcl_CreateObjCommand(interp, "spi_prepare",
*************** pltclu_call_handler(PG_FUNCTION_ARGS)
*** 625,653 ****
  }


  static Datum
  pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
  {
      Datum        retval;
!     FunctionCallInfo save_fcinfo;
!     pltcl_proc_desc *save_prodesc;
!     pltcl_proc_desc *this_prodesc;

      /*
!      * Ensure that static pointers are saved/restored properly
       */
!     save_fcinfo = pltcl_current_fcinfo;
!     save_prodesc = pltcl_current_prodesc;

      /*
!      * Reset pltcl_current_prodesc to null.  Anything that sets it non-null
!      * should increase the prodesc's fn_refcount at the same time.  We'll
!      * decrease the refcount, and then delete the prodesc if it's no longer
!      * referenced, on the way out of this function.  This ensures that
!      * prodescs live as long as needed even if somebody replaces the
!      * originating pg_proc row while they're executing.
       */
!     pltcl_current_prodesc = NULL;

      PG_TRY();
      {
--- 664,696 ----
  }


+ /**********************************************************************
+  * pltcl_handler()        - Handler for function and trigger calls, for
+  *                          both trusted and untrusted interpreters.
+  **********************************************************************/
  static Datum
  pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
  {
      Datum        retval;
!     pltcl_call_state current_call_state;
!     pltcl_call_state *save_call_state;

      /*
!      * Initialize current_call_state to nulls/zeroes; in particular, set its
!      * prodesc pointer to null.  Anything that sets it non-null should
!      * increase the prodesc's fn_refcount at the same time.  We'll decrease
!      * the refcount, and then delete the prodesc if it's no longer referenced,
!      * on the way out of this function.  This ensures that prodescs live as
!      * long as needed even if somebody replaces the originating pg_proc row
!      * while they're executing.
       */
!     memset(¤t_call_state, 0, sizeof(current_call_state));

      /*
!      * Ensure that static pointer is saved/restored properly
       */
!     save_call_state = pltcl_current_call_state;
!     pltcl_current_call_state = ¤t_call_state;

      PG_TRY();
      {
*************** pltcl_handler(PG_FUNCTION_ARGS, bool plt
*** 657,703 ****
           */
          if (CALLED_AS_TRIGGER(fcinfo))
          {
!             pltcl_current_fcinfo = NULL;
!             retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted));
          }
          else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
          {
!             pltcl_current_fcinfo = NULL;
!             pltcl_event_trigger_handler(fcinfo, pltrusted);
              retval = (Datum) 0;
          }
          else
          {
!             pltcl_current_fcinfo = fcinfo;
!             retval = pltcl_func_handler(fcinfo, pltrusted);
          }
      }
      PG_CATCH();
      {
!         /* Restore globals, then clean up the prodesc refcount if any */
!         this_prodesc = pltcl_current_prodesc;
!         pltcl_current_fcinfo = save_fcinfo;
!         pltcl_current_prodesc = save_prodesc;
!         if (this_prodesc != NULL)
          {
!             Assert(this_prodesc->fn_refcount > 0);
!             if (--this_prodesc->fn_refcount == 0)
!                 MemoryContextDelete(this_prodesc->fn_cxt);
          }
          PG_RE_THROW();
      }
      PG_END_TRY();

!     /* Restore globals, then clean up the prodesc refcount if any */
      /* (We're being paranoid in case an error is thrown in context deletion) */
!     this_prodesc = pltcl_current_prodesc;
!     pltcl_current_fcinfo = save_fcinfo;
!     pltcl_current_prodesc = save_prodesc;
!     if (this_prodesc != NULL)
      {
!         Assert(this_prodesc->fn_refcount > 0);
!         if (--this_prodesc->fn_refcount == 0)
!             MemoryContextDelete(this_prodesc->fn_cxt);
      }

      return retval;
--- 700,745 ----
           */
          if (CALLED_AS_TRIGGER(fcinfo))
          {
!             /* invoke the trigger handler */
!             retval = PointerGetDatum(pltcl_trigger_handler(fcinfo,
!                                                          ¤t_call_state,
!                                                            pltrusted));
          }
          else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
          {
!             /* invoke the event trigger handler */
!             pltcl_event_trigger_handler(fcinfo, ¤t_call_state, pltrusted);
              retval = (Datum) 0;
          }
          else
          {
!             /* invoke the regular function handler */
!             current_call_state.fcinfo = fcinfo;
!             retval = pltcl_func_handler(fcinfo, ¤t_call_state, pltrusted);
          }
      }
      PG_CATCH();
      {
!         /* Restore static pointer, then clean up the prodesc refcount if any */
!         pltcl_current_call_state = save_call_state;
!         if (current_call_state.prodesc != NULL)
          {
!             Assert(current_call_state.prodesc->fn_refcount > 0);
!             if (--current_call_state.prodesc->fn_refcount == 0)
!                 MemoryContextDelete(current_call_state.prodesc->fn_cxt);
          }
          PG_RE_THROW();
      }
      PG_END_TRY();

!     /* Restore static pointer, then clean up the prodesc refcount if any */
      /* (We're being paranoid in case an error is thrown in context deletion) */
!     pltcl_current_call_state = save_call_state;
!     if (current_call_state.prodesc != NULL)
      {
!         Assert(current_call_state.prodesc->fn_refcount > 0);
!         if (--current_call_state.prodesc->fn_refcount == 0)
!             MemoryContextDelete(current_call_state.prodesc->fn_cxt);
      }

      return retval;
*************** pltcl_handler(PG_FUNCTION_ARGS, bool plt
*** 708,714 ****
   * pltcl_func_handler()        - Handler for regular function calls
   **********************************************************************/
  static Datum
! pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
  {
      pltcl_proc_desc *prodesc;
      Tcl_Interp *volatile interp;
--- 750,757 ----
   * pltcl_func_handler()        - Handler for regular function calls
   **********************************************************************/
  static Datum
! pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
!                    bool pltrusted)
  {
      pltcl_proc_desc *prodesc;
      Tcl_Interp *volatile interp;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 725,735 ****
      prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
                                       false, pltrusted);

!     pltcl_current_prodesc = prodesc;
      prodesc->fn_refcount++;

      interp = prodesc->interp_desc->interp;

      /************************************************************
       * Create the tcl command to call the internal
       * proc in the Tcl interpreter
--- 768,799 ----
      prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
                                       false, pltrusted);

!     call_state->prodesc = prodesc;
      prodesc->fn_refcount++;

      interp = prodesc->interp_desc->interp;

+     /*
+      * If we're a SRF, check caller can handle materialize mode, and save
+      * relevant info into call_state.  We must ensure that the returned
+      * tuplestore is owned by the caller's context, even if we first create it
+      * inside a subtransaction.
+      */
+     if (prodesc->fn_retisset)
+     {
+         ReturnSetInfo *rsi = (ReturnSetInfo *) fcinfo->resultinfo;
+
+         if (!rsi || !IsA(rsi, ReturnSetInfo) ||
+             (rsi->allowedModes & SFRM_Materialize) == 0)
+             ereport(ERROR,
+                     (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+                      errmsg("set-valued function called in context that cannot accept a set")));
+
+         call_state->rsi = rsi;
+         call_state->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory;
+         call_state->tuple_store_owner = CurrentResourceOwner;
+     }
+
      /************************************************************
       * Create the tcl command to call the internal
       * proc in the Tcl interpreter
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 838,848 ****
      if (SPI_finish() != SPI_OK_FINISH)
          elog(ERROR, "SPI_finish() failed");

!     if (fcinfo->isnull)
          retval = InputFunctionCall(&prodesc->result_in_func,
                                     NULL,
                                     prodesc->result_typioparam,
                                     -1);
      else
          retval = InputFunctionCall(&prodesc->result_in_func,
                                     utf_u2e(Tcl_GetStringResult(interp)),
--- 902,973 ----
      if (SPI_finish() != SPI_OK_FINISH)
          elog(ERROR, "SPI_finish() failed");

!     if (prodesc->fn_retisset)
!     {
!         ReturnSetInfo *rsi = call_state->rsi;
!
!         /* We already checked this is OK */
!         rsi->returnMode = SFRM_Materialize;
!
!         /* If we produced any tuples, send back the result */
!         if (call_state->tuple_store)
!         {
!             rsi->setResult = call_state->tuple_store;
!             if (call_state->ret_tupdesc)
!             {
!                 MemoryContext oldcxt;
!
!                 oldcxt = MemoryContextSwitchTo(call_state->tuple_store_cxt);
!                 rsi->setDesc = CreateTupleDescCopy(call_state->ret_tupdesc);
!                 MemoryContextSwitchTo(oldcxt);
!             }
!         }
!         retval = (Datum) 0;
!         fcinfo->isnull = true;
!     }
!     else if (fcinfo->isnull)
!     {
          retval = InputFunctionCall(&prodesc->result_in_func,
                                     NULL,
                                     prodesc->result_typioparam,
                                     -1);
+     }
+     else if (prodesc->fn_retistuple)
+     {
+         TupleDesc    td;
+         HeapTuple    tup;
+         Tcl_Obj    *resultObj;
+         Tcl_Obj   **resultObjv;
+         int            resultObjc;
+
+         /*
+          * Set up data about result type.  XXX it's tempting to consider
+          * caching this in the prodesc, in the common case where the rowtype
+          * is determined by the function not the calling query.  But we'd have
+          * to be able to deal with ADD/DROP/ALTER COLUMN events when the
+          * result type is a named composite type, so it's not exactly trivial.
+          * Maybe worth improving someday.
+          */
+         if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
+             ereport(ERROR,
+                     (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+                      errmsg("function returning record called in context "
+                             "that cannot accept type record")));
+
+         Assert(!call_state->ret_tupdesc);
+         Assert(!call_state->attinmeta);
+         call_state->ret_tupdesc = td;
+         call_state->attinmeta = TupleDescGetAttInMetadata(td);
+
+         /* Convert function result to tuple */
+         resultObj = Tcl_GetObjResult(interp);
+         if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
+             throw_tcl_error(interp, prodesc->user_proname);
+
+         tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc,
+                                        call_state);
+         retval = HeapTupleGetDatum(tup);
+     }
      else
          retval = InputFunctionCall(&prodesc->result_in_func,
                                     utf_u2e(Tcl_GetStringResult(interp)),
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 857,863 ****
   * pltcl_trigger_handler()    - Handler for trigger calls
   **********************************************************************/
  static HeapTuple
! pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
  {
      pltcl_proc_desc *prodesc;
      Tcl_Interp *volatile interp;
--- 982,989 ----
   * pltcl_trigger_handler()    - Handler for trigger calls
   **********************************************************************/
  static HeapTuple
! pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
!                       bool pltrusted)
  {
      pltcl_proc_desc *prodesc;
      Tcl_Interp *volatile interp;
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 887,893 ****
                                       false,        /* not an event trigger */
                                       pltrusted);

!     pltcl_current_prodesc = prodesc;
      prodesc->fn_refcount++;

      interp = prodesc->interp_desc->interp;
--- 1013,1019 ----
                                       false,        /* not an event trigger */
                                       pltrusted);

!     call_state->prodesc = prodesc;
      prodesc->fn_refcount++;

      interp = prodesc->interp_desc->interp;
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 1188,1194 ****
   * pltcl_event_trigger_handler()    - Handler for event trigger calls
   **********************************************************************/
  static void
! pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
  {
      pltcl_proc_desc *prodesc;
      Tcl_Interp *volatile interp;
--- 1314,1321 ----
   * pltcl_event_trigger_handler()    - Handler for event trigger calls
   **********************************************************************/
  static void
! pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
!                             bool pltrusted)
  {
      pltcl_proc_desc *prodesc;
      Tcl_Interp *volatile interp;
*************** pltcl_event_trigger_handler(PG_FUNCTION_
*** 1204,1210 ****
      prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
                                       InvalidOid, true, pltrusted);

!     pltcl_current_prodesc = prodesc;
      prodesc->fn_refcount++;

      interp = prodesc->interp_desc->interp;
--- 1331,1337 ----
      prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
                                       InvalidOid, true, pltrusted);

!     call_state->prodesc = prodesc;
      prodesc->fn_refcount++;

      interp = prodesc->interp_desc->interp;
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1408,1417 ****
                       procStruct->prorettype);
              typeStruct = (Form_pg_type) GETSTRUCT(typeTup);

!             /* Disallow pseudotype result, except VOID */
              if (typeStruct->typtype == TYPTYPE_PSEUDO)
              {
!                 if (procStruct->prorettype == VOIDOID)
                       /* okay */ ;
                  else if (procStruct->prorettype == TRIGGEROID ||
                           procStruct->prorettype == EVTTRIGGEROID)
--- 1535,1545 ----
                       procStruct->prorettype);
              typeStruct = (Form_pg_type) GETSTRUCT(typeTup);

!             /* Disallow pseudotype result, except VOID and RECORD */
              if (typeStruct->typtype == TYPTYPE_PSEUDO)
              {
!                 if (procStruct->prorettype == VOIDOID ||
!                     procStruct->prorettype == RECORDOID)
                       /* okay */ ;
                  else if (procStruct->prorettype == TRIGGEROID ||
                           procStruct->prorettype == EVTTRIGGEROID)
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1425,1440 ****
                                      format_type_be(procStruct->prorettype))));
              }

-             if (typeStruct->typtype == TYPTYPE_COMPOSITE)
-                 ereport(ERROR,
-                         (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
-                   errmsg("PL/Tcl functions cannot return composite types")));
-
              fmgr_info_cxt(typeStruct->typinput,
                            &(prodesc->result_in_func),
                            proc_cxt);
              prodesc->result_typioparam = getTypeIOParam(typeTup);

              ReleaseSysCache(typeTup);
          }

--- 1553,1567 ----
                                      format_type_be(procStruct->prorettype))));
              }

              fmgr_info_cxt(typeStruct->typinput,
                            &(prodesc->result_in_func),
                            proc_cxt);
              prodesc->result_typioparam = getTypeIOParam(typeTup);

+             prodesc->fn_retisset = procStruct->proretset;
+             prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID ||
+                                    typeStruct->typtype == TYPTYPE_COMPOSITE);
+
              ReleaseSysCache(typeTup);
          }

*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1933,1939 ****
                  int objc, Tcl_Obj *const objv[])
  {
      int            argno;
!     FunctionCallInfo fcinfo = pltcl_current_fcinfo;

      /************************************************************
       * Check call syntax
--- 2060,2066 ----
                  int objc, Tcl_Obj *const objv[])
  {
      int            argno;
!     FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo;

      /************************************************************
       * Check call syntax
*************** static int
*** 1986,1992 ****
  pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
                   int objc, Tcl_Obj *const objv[])
  {
!     FunctionCallInfo fcinfo = pltcl_current_fcinfo;

      /************************************************************
       * Check call syntax
--- 2113,2119 ----
  pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
                   int objc, Tcl_Obj *const objv[])
  {
!     FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo;

      /************************************************************
       * Check call syntax
*************** pltcl_returnnull(ClientData cdata, Tcl_I
*** 2017,2022 ****
--- 2144,2221 ----
  }


+ /**********************************************************************
+  * pltcl_returnnext()    - Add a row to the result tuplestore in a SRF.
+  **********************************************************************/
+ static int
+ pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
+                  int objc, Tcl_Obj *const objv[])
+ {
+     pltcl_call_state *call_state = pltcl_current_call_state;
+     FunctionCallInfo fcinfo = call_state->fcinfo;
+     pltcl_proc_desc *prodesc = call_state->prodesc;
+
+     /*
+      * Check that we're called as a set-returning function
+      */
+     if (fcinfo == NULL)
+     {
+         Tcl_SetObjResult(interp,
+              Tcl_NewStringObj("return_next cannot be used in triggers", -1));
+         return TCL_ERROR;
+     }
+
+     if (!prodesc->fn_retisset)
+     {
+         Tcl_SetObjResult(interp,
+                          Tcl_NewStringObj("return_next cannot be used in non-set-returning functions", -1));
+         return TCL_ERROR;
+     }
+
+     /*
+      * Check call syntax
+      */
+     if (objc != 2)
+     {
+         Tcl_WrongNumArgs(interp, 1, objv, "result");
+         return TCL_ERROR;
+     }
+
+     /* Set up tuple store if first output row */
+     if (call_state->tuple_store == NULL)
+         pltcl_init_tuple_store(call_state);
+
+     if (prodesc->fn_retistuple)
+     {
+         Tcl_Obj   **rowObjv;
+         int            rowObjc;
+         HeapTuple    tuple;
+
+         /* result should be a list, so break it down */
+         if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
+             return TCL_ERROR;
+         tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc, call_state);
+         tuplestore_puttuple(call_state->tuple_store, tuple);
+     }
+     else
+     {
+         Datum        retval;
+         bool        isNull = false;
+
+         UTF_BEGIN;
+         retval = InputFunctionCall(&prodesc->result_in_func,
+                                    UTF_U2E((char *) Tcl_GetString(objv[1])),
+                                    prodesc->result_typioparam,
+                                    -1);
+         UTF_END;
+         tuplestore_putvalues(call_state->tuple_store, call_state->ret_tupdesc,
+                              &retval, &isNull);
+     }
+
+     return TCL_OK;
+ }
+
+
  /*----------
   * Support for running SPI operations inside subtransactions
   *
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 2183,2189 ****
      {
          UTF_BEGIN;
          spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])),
!                              pltcl_current_prodesc->fn_readonly, count);
          UTF_END;

          my_rc = pltcl_process_SPI_result(interp,
--- 2382,2388 ----
      {
          UTF_BEGIN;
          spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])),
!                       pltcl_current_call_state->prodesc->fn_readonly, count);
          UTF_END;

          my_rc = pltcl_process_SPI_result(interp,
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2433,2439 ****
       * Insert a hashtable entry for the plan and return
       * the key to the caller
       ************************************************************/
!     query_hash = &pltcl_current_prodesc->interp_desc->query_hash;

      hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
      Tcl_SetHashValue(hashent, (ClientData) qdesc);
--- 2632,2638 ----
       * Insert a hashtable entry for the plan and return
       * the key to the caller
       ************************************************************/
!     query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash;

      hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
      Tcl_SetHashValue(hashent, (ClientData) qdesc);
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2522,2528 ****
          return TCL_ERROR;
      }

!     query_hash = &pltcl_current_prodesc->interp_desc->query_hash;

      hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i]));
      if (hashent == NULL)
--- 2721,2727 ----
          return TCL_ERROR;
      }

!     query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash;

      hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i]));
      if (hashent == NULL)
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2637,2643 ****
           * Execute the plan
           ************************************************************/
          spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
!                                   pltcl_current_prodesc->fn_readonly, count);

          my_rc = pltcl_process_SPI_result(interp,
                                           arrayname,
--- 2836,2843 ----
           * Execute the plan
           ************************************************************/
          spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
!                               pltcl_current_call_state->prodesc->fn_readonly,
!                                   count);

          my_rc = pltcl_process_SPI_result(interp,
                                           arrayname,
*************** pltcl_build_tuple_argument(HeapTuple tup
*** 2822,2824 ****
--- 3022,3106 ----

      return retobj;
  }
+
+ /**********************************************************************
+  * pltcl_build_tuple_result() - Build a tuple of function's result rowtype
+  *                  from a Tcl list of column names and values
+  **********************************************************************/
+ static HeapTuple
+ pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc,
+                          pltcl_call_state *call_state)
+ {
+     HeapTuple    tup;
+     char      **values;
+     int            i;
+
+     if (kvObjc & 1)
+         ereport(ERROR,
+                 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
+                  errmsg("column name/value list must have an even number of elements")));
+
+     values = (char **) palloc0(call_state->ret_tupdesc->natts * sizeof(char *));
+
+     for (i = 0; i < kvObjc; i += 2)
+     {
+         char       *fieldName = Tcl_GetString(kvObjv[i]);
+         int            attn = SPI_fnumber(call_state->ret_tupdesc, fieldName);
+
+         if (attn <= 0 || call_state->ret_tupdesc->attrs[attn - 1]->attisdropped)
+             ereport(ERROR,
+                     (errcode(ERRCODE_UNDEFINED_COLUMN),
+                      errmsg("column name/value list contains nonexistent column name \"%s\"",
+                             fieldName)));
+
+         UTF_BEGIN;
+         values[attn - 1] = UTF_E2U(Tcl_GetString(kvObjv[i + 1]));
+         UTF_END;
+     }
+
+     tup = BuildTupleFromCStrings(call_state->attinmeta, values);
+     pfree(values);
+     return tup;
+ }
+
+ /**********************************************************************
+  * pltcl_init_tuple_store() - Initialize the result tuplestore for a SRF
+  **********************************************************************/
+ static void
+ pltcl_init_tuple_store(pltcl_call_state *call_state)
+ {
+     ReturnSetInfo *rsi = call_state->rsi;
+     MemoryContext oldcxt;
+     ResourceOwner oldowner;
+
+     /* Should be in a SRF */
+     Assert(rsi);
+     /* Should be first time through */
+     Assert(!call_state->tuple_store);
+     Assert(!call_state->attinmeta);
+
+     /* We expect caller to provide an appropriate result tupdesc */
+     Assert(rsi->expectedDesc);
+     call_state->ret_tupdesc = rsi->expectedDesc;
+
+     /*
+      * Switch to the right memory context and resource owner for storing the
+      * tuplestore. If we're within a subtransaction opened for an exception
+      * block, for example, we must still create the tuplestore in the resource
+      * owner that was active when this function was entered, and not in the
+      * subtransaction's resource owner.
+      */
+     oldcxt = MemoryContextSwitchTo(call_state->tuple_store_cxt);
+     oldowner = CurrentResourceOwner;
+     CurrentResourceOwner = call_state->tuple_store_owner;
+
+     call_state->tuple_store =
+         tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
+                               false, work_mem);
+
+     /* Build attinmeta in this context, too */
+     call_state->attinmeta = TupleDescGetAttInMetadata(call_state->ret_tupdesc);
+
+     CurrentResourceOwner = oldowner;
+     MemoryContextSwitchTo(oldcxt);
+ }
diff --git a/src/pl/tcl/sql/pltcl_queries.sql b/src/pl/tcl/sql/pltcl_queries.sql
index a0a9619..0ebfe65 100644
*** a/src/pl/tcl/sql/pltcl_queries.sql
--- b/src/pl/tcl/sql/pltcl_queries.sql
*************** create temp table t1 (f1 int);
*** 97,99 ****
--- 97,132 ----
  select tcl_lastoid('t1');
  create temp table t2 (f1 int) with oids;
  select tcl_lastoid('t2') > 0;
+
+ -- test some error cases
+ CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl;
+ SELECT tcl_error();
+
+ CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ LANGUAGE pltcl;
+ SELECT bad_record();
+
+ CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 cow 3]$$ LANGUAGE pltcl;
+ SELECT bad_field();
+
+ -- test compound return
+ select * from tcl_test_cube_squared(5);
+
+ -- test SRF
+ select * from tcl_test_squared_rows(0,5);
+
+ select * from tcl_test_sequence(0,5) as a;
+
+ select 1, tcl_test_sequence(0,5);
+
+ CREATE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl;
+ select non_srf();
+
+ CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
+ return_next [list a]
+ $$ LANGUAGE pltcl;
+ SELECT bad_record_srf();
+
+ CREATE FUNCTION bad_field_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
+ return_next [list a 1 b 2 cow 3]
+ $$ LANGUAGE pltcl;
+ SELECT bad_field_srf();
diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql
index 8df65a5..58f38d5 100644
*** a/src/pl/tcl/sql/pltcl_setup.sql
--- b/src/pl/tcl/sql/pltcl_setup.sql
*************** drop table foo;
*** 596,601 ****
--- 596,617 ----
  drop event trigger tcl_a_snitch;
  drop event trigger tcl_b_snitch;

+ CREATE FUNCTION tcl_test_cube_squared(in int, out squared int, out cubed int) AS $$
+     return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
+ $$ language pltcl;
+
+ CREATE FUNCTION tcl_test_squared_rows(int,int) RETURNS TABLE (x int, y int) AS $$
+     for {set i $1} {$i < $2} {incr i} {
+         return_next [list y [expr {$i * $i}] x $i]
+     }
+ $$ language pltcl;
+
+ CREATE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$
+     for {set i $1} {$i < $2} {incr i} {
+         return_next $i
+     }
+ $$ language pltcl;
+
  -- test use of errorCode in error handling

  create function tcl_error_handling_test() returns text as $$