Fix plperl and pltcl error handling per my previous proposal. SPI

operations are now run as subtransactions, so that errors in them
can be reported as ordinary Perl or Tcl errors and caught by the
normal error handling convention of those languages.  Also do some
minor code cleanup in pltcl.c: extract a large chunk of duplicated
code in pltcl_SPI_execute and pltcl_SPI_execute_plan into a shared
subroutine.

doc/src/sgml/plperl.sgml

 <!--
-$PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.31 2004/11/19 23:22:54 tgl Exp $
+$PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.32 2004/11/21 21:17:01 tgl Exp $
 -->
 
  <chapter id="plperl">
@@ -219,9 +219,13 @@ $nrows = $rv-&gt;{processed};
        Emit a log or error message. Possible levels are
        <literal>DEBUG</>, <literal>LOG</>, <literal>INFO</>,
        <literal>NOTICE</>, <literal>WARNING</>, and <literal>ERROR</>.
-       <literal>ERROR</> raises an error condition: further execution
-       of the function is abandoned, and the current transaction is
-       aborted.
+       <literal>ERROR</>
+        raises an error condition; if this is not trapped by the surrounding
+        Perl code, the error propagates out to the calling query, causing
+        the current transaction or subtransaction to be aborted.  This
+        is effectively the same as the Perl <literal>die</> command.
+        The other levels simply report the message to the system log
+        and/or client.
       </para>
      </listitem>
     </varlistentry>

doc/src/sgml/pltcl.sgml

 <!--
-$PostgreSQL: pgsql/doc/src/sgml/pltcl.sgml,v 2.31 2004/09/20 22:48:25 tgl Exp $
+$PostgreSQL: pgsql/doc/src/sgml/pltcl.sgml,v 2.32 2004/11/21 21:17:02 tgl Exp $
 -->
 
  <chapter id="pltcl">
@@ -449,17 +449,19 @@ SELECT 'doesn''t' AS ret
       <term><function>elog</> <replaceable>level</replaceable> <replaceable>msg</replaceable></term>
       <listitem>
        <para>
-	Emits a log or error message. Possible levels are
-	<literal>DEBUG</>, <literal>LOG</>, <literal>INFO</>,
-	<literal>NOTICE</>, <literal>WARNING</>, <literal>ERROR</>, and
-	<literal>FATAL</>. Most simply emit the given message just like
-	the <literal>elog</> C function. <literal>ERROR</>
-	raises an error condition: further execution of the function is
-	abandoned, and the current transaction is aborted.
-	<literal>FATAL</> aborts the transaction and causes the current
-	session to shut down.  (There is probably no good reason to use
-	this error level in PL/Tcl functions, but it's provided for
-	completeness.)
+        Emits a log or error message. Possible levels are
+        <literal>DEBUG</>, <literal>LOG</>, <literal>INFO</>,
+        <literal>NOTICE</>, <literal>WARNING</>, <literal>ERROR</>, and
+        <literal>FATAL</>. Most simply emit the given message just like
+        the <literal>elog</> C function. <literal>ERROR</>
+        raises an error condition; if this is not trapped by the surrounding
+        Tcl code, the error propagates out to the calling query, causing
+        the current transaction or subtransaction to be aborted.  This
+        is effectively the same as the Tcl <literal>error</> command.
+        <literal>FATAL</> aborts the transaction and causes the current
+        session to shut down.  (There is probably no good reason to use
+        this error level in PL/Tcl functions, but it's provided for
+        completeness.)
        </para>
       </listitem>
      </varlistentry>

doc/src/sgml/release.sgml

 <!--
-$PostgreSQL: pgsql/doc/src/sgml/release.sgml,v 1.309 2004/11/20 21:44:24 tgl Exp $
+$PostgreSQL: pgsql/doc/src/sgml/release.sgml,v 1.310 2004/11/21 21:17:02 tgl Exp $
 -->
 
 <appendix id="release">
@@ -1686,6 +1686,15 @@ $PostgreSQL: pgsql/doc/src/sgml/release.sgml,v 1.309 2004/11/20 21:44:24 tgl Exp
      </para>
     </listitem>
 
+    <listitem>
+     <para>
+      In PL/Tcl, SPI commands are now run in subtransactions.  If an error
+      occurs, the subtransaction is cleaned up and the error is reported
+      as an ordinary Tcl error, which can be trapped with <literal>catch</>.
+      Formerly, it was not possible to catch such errors.
+     </para>
+    </listitem>
+
    </itemizedlist>
   </sect3>
 

src/pl/plperl/plperl.c

@@ -33,7 +33,7 @@
  *	  ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.59 2004/11/20 19:07:40 tgl Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.60 2004/11/21 21:17:03 tgl Exp $
  *
  **********************************************************************/
 
@@ -1593,20 +1593,79 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 }
 
 
+/*
+ * Implementation of spi_exec_query() Perl function
+ */
 HV *
 plperl_spi_exec(char *query, int limit)
 {
 	HV		   *ret_hv;
-	int			spi_rv;
 
-	spi_rv = SPI_execute(query, plperl_current_prodesc->fn_readonly, limit);
-	ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed, spi_rv);
+	/*
+	 * Execute the query inside a sub-transaction, so we can cope with
+	 * errors sanely
+	 */
+	MemoryContext oldcontext = CurrentMemoryContext;
+	ResourceOwner oldowner = CurrentResourceOwner;
+
+	BeginInternalSubTransaction(NULL);
+	/* Want to run inside function's memory context */
+	MemoryContextSwitchTo(oldcontext);
+
+	PG_TRY();
+	{
+		int			spi_rv;
+
+		spi_rv = SPI_execute(query, plperl_current_prodesc->fn_readonly,
+							 limit);
+		ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
+												 spi_rv);
+
+		/* Commit the inner transaction, return to outer xact context */
+		ReleaseCurrentSubTransaction();
+		MemoryContextSwitchTo(oldcontext);
+		CurrentResourceOwner = oldowner;
+		/*
+		 * AtEOSubXact_SPI() should not have popped any SPI context,
+		 * but just in case it did, make sure we remain connected.
+		 */
+		SPI_restore_connection();
+	}
+	PG_CATCH();
+	{
+		ErrorData  *edata;
+
+		/* Save error info */
+		MemoryContextSwitchTo(oldcontext);
+		edata = CopyErrorData();
+		FlushErrorState();
+
+		/* Abort the inner transaction */
+		RollbackAndReleaseCurrentSubTransaction();
+		MemoryContextSwitchTo(oldcontext);
+		CurrentResourceOwner = oldowner;
+
+		/*
+		 * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+		 * it will have left us in a disconnected state.  We need this
+		 * hack to return to connected state.
+		 */
+		SPI_restore_connection();
+
+		/* Punt the error to Perl */
+		croak("%s", edata->message);
+
+		/* Can't get here, but keep compiler quiet */
+		return NULL;
+	}
+	PG_END_TRY();
 
 	return ret_hv;
 }
 
 static HV  *
-plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status)
+plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed,
+								int status)
 {
 	HV		   *result;
 
@@ -1619,21 +1678,18 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int stat
 
 	if (status == SPI_OK_SELECT)
 	{
-		if (processed)
-		{
-			AV		   *rows;
-			HV		   *row;
-			int			i;
+		AV		   *rows;
+		HV		   *row;
+		int			i;
 
-			rows = newAV();
-			for (i = 0; i < processed; i++)
-			{
-				row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
-				av_push(rows, newRV_noinc((SV *)row));
-			}
-			hv_store(result, "rows", strlen("rows"),
-					 newRV_noinc((SV *) rows), 0);
+		rows = newAV();
+		for (i = 0; i < processed; i++)
+		{
+			row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
+			av_push(rows, newRV_noinc((SV *)row));
 		}
+		hv_store(result, "rows", strlen("rows"),
+				 newRV_noinc((SV *) rows), 0);
 	}
 
 	SPI_freetuptable(tuptable);

src/pl/tcl/test/runtest

@@ -6,6 +6,8 @@ export DBNAME
 echo "**** Destroy old database $DBNAME ****"
 dropdb $DBNAME
 
+sleep 1
+
 echo "**** Create test database $DBNAME ****"
 createdb $DBNAME
 

src/pl/tcl/test/test_queries.sql

+-- suppress CONTEXT so that function OIDs aren't in output
+\set VERBOSITY terse
 
 insert into T_pkey1 values (1, 'key1-1', 'test key');
 insert into T_pkey1 values (1, 'key1-2', 'test key');

src/pl/tcl/test/test_setup.sql

+--
+-- checkpoint so that if we have a crash in the tests, replay of the
+-- just-completed CREATE DATABASE won't discard the core dump file
+--
+checkpoint;
+
 --
 -- Create the tables used in the test queries
 --