Fix error handling in pltcl_returnnext.

We can't throw elog(ERROR) out of a Tcl command procedure; we have
to catch the error and return TCL_ERROR to the Tcl interpreter.
pltcl_returnnext failed to meet this requirement, so that errors
detected by pltcl_build_tuple_result or other functions called here
led to longjmp'ing out of the Tcl interpreter and thereby leaving it
in a bad state.  Use the existing subtransaction support to prevent
that.  Oversight in commit 26abb50c4, found more or less accidentally
by the buildfarm thanks to the tests added in 961bed020.

Report: https://postgr.es/m/30647.1483989734@sss.pgh.pa.us

diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index d813dcb3a61b590276b193c6bb3107516c3fca2c..ec5b54ab324464e18ec672bd68b8a3a929c1bc48 100644 (file)
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -299,6 +299,14 @@ static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
 static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
                                  int objc, Tcl_Obj *const objv[]);
 
+static void pltcl_subtrans_begin(MemoryContext oldcontext,
+                                        ResourceOwner oldowner);
+static void pltcl_subtrans_commit(MemoryContext oldcontext,
+                                         ResourceOwner oldowner);
+static void pltcl_subtrans_abort(Tcl_Interp *interp,
+                                        MemoryContext oldcontext,
+                                        ResourceOwner oldowner);
+
 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);
@@ -2073,9 +2081,9 @@ pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
        pltcl_call_state *call_state = pltcl_current_call_state;
        FunctionCallInfo fcinfo = call_state->fcinfo;
        pltcl_proc_desc *prodesc = call_state->prodesc;
-       int                     result = TCL_OK;
-       MemoryContext tmpcxt;
-       MemoryContext oldcxt;
+       MemoryContext oldcontext = CurrentMemoryContext;
+       ResourceOwner oldowner = CurrentResourceOwner;
+       volatile int result = TCL_OK;
 
        /*
         * Check that we're called as a set-returning function
@@ -2103,52 +2111,63 @@ pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
                return TCL_ERROR;
        }
 
-       /* Set up tuple store if first output row */
-       if (call_state->tuple_store == NULL)
-               pltcl_init_tuple_store(call_state);
+       /*
+        * The rest might throw elog(ERROR), so must run in a subtransaction.
+        *
+        * A small advantage of using a subtransaction is that it provides a
+        * short-lived memory context for free, so we needn't worry about leaking
+        * memory here.  To use that context, call BeginInternalSubTransaction
+        * directly instead of going through pltcl_subtrans_begin.
+        */
+       BeginInternalSubTransaction(NULL);
+       PG_TRY();
+       {
+               /* Set up tuple store if first output row */
+               if (call_state->tuple_store == NULL)
+                       pltcl_init_tuple_store(call_state);
 
-       /* Make short-lived context to run input functions in */
-       tmpcxt = AllocSetContextCreate(CurrentMemoryContext,
-                                                                  "pltcl_returnnext",
-                                                                  ALLOCSET_SMALL_SIZES);
-       oldcxt = MemoryContextSwitchTo(tmpcxt);
+               if (prodesc->fn_retistuple)
+               {
+                       Tcl_Obj   **rowObjv;
+                       int                     rowObjc;
 
-       if (prodesc->fn_retistuple)
-       {
-               Tcl_Obj   **rowObjv;
-               int                     rowObjc;
+                       /* result should be a list, so break it down */
+                       if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
+                               result = TCL_ERROR;
+                       else
+                       {
+                               HeapTuple       tuple;
 
-               /* result should be a list, so break it down */
-               if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
-                       result = TCL_ERROR;
+                               tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc,
+                                                                                                call_state);
+                               tuplestore_puttuple(call_state->tuple_store, tuple);
+                       }
+               }
                else
                {
-                       HeapTuple       tuple;
-
-                       tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc,
-                                                                                        call_state);
-                       tuplestore_puttuple(call_state->tuple_store, tuple);
+                       Datum           retval;
+                       bool            isNull = false;
+
+                       /* for paranoia's sake, check that tupdesc has exactly one column */
+                       if (call_state->ret_tupdesc->natts != 1)
+                               elog(ERROR, "wrong result type supplied in return_next");
+
+                       retval = InputFunctionCall(&prodesc->result_in_func,
+                                                                       utf_u2e((char *) Tcl_GetString(objv[1])),
+                                                                          prodesc->result_typioparam,
+                                                                          -1);
+                       tuplestore_putvalues(call_state->tuple_store, call_state->ret_tupdesc,
+                                                                &retval, &isNull);
                }
+
+               pltcl_subtrans_commit(oldcontext, oldowner);
        }
-       else
+       PG_CATCH();
        {
-               Datum           retval;
-               bool            isNull = false;
-
-               /* for paranoia's sake, check that tupdesc has exactly one column */
-               if (call_state->ret_tupdesc->natts != 1)
-                       elog(ERROR, "wrong result type supplied in return_next");
-
-               retval = InputFunctionCall(&prodesc->result_in_func,
-                                                                  utf_u2e((char *) Tcl_GetString(objv[1])),
-                                                                  prodesc->result_typioparam,
-                                                                  -1);
-               tuplestore_putvalues(call_state->tuple_store, call_state->ret_tupdesc,
-                                                        &retval, &isNull);
+               pltcl_subtrans_abort(interp, oldcontext, oldowner);
+               return TCL_ERROR;
        }
-
-       MemoryContextSwitchTo(oldcxt);
-       MemoryContextDelete(tmpcxt);
+       PG_END_TRY();
 
        return result;
 }