From 3cabc675ab40035c8498cacde76186c598aa373d Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Thu, 28 Jun 2007 17:49:59 +0000
Subject: [PATCH] Fix incorrect tests for undef Perl values in some places in
 plperl.c. The correct test for defined-ness is SvOK(sv), not anything
 involving SvTYPE.  Per bug #3415 from Matt Taylor. Back-patch as far as 8.0;
 no apparent problem in 7.x.

---
 src/pl/plperl/plperl.c | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index ff484f4dbe..0c32bb4718 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1,7 +1,7 @@
 /**********************************************************************
  * plperl.c - perl as a procedural language for PostgreSQL
  *
- *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.128 2007/04/02 03:49:41 tgl Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.129 2007/06/28 17:49:59 tgl Exp $
  *
  **********************************************************************/
 
@@ -547,7 +547,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
 					(errcode(ERRCODE_UNDEFINED_COLUMN),
 					 errmsg("Perl hash contains nonexistent column \"%s\"",
 							key)));
-		if (SvOK(val) && SvTYPE(val) != SVt_NULL)
+		if (SvOK(val))
 			values[attn - 1] = SvPV(val, PL_na);
 	}
 	hv_iterinit(perlhash);
@@ -743,7 +743,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
 						 &typinput, &typioparam);
 		fmgr_info(typinput, &finfo);
 		atttypmod = tupdesc->attrs[attn - 1]->atttypmod;
-		if (SvOK(val) && SvTYPE(val) != SVt_NULL)
+		if (SvOK(val))
 		{
 			modvalues[slotsused] = InputFunctionCall(&finfo,
 													 SvPV(val, PL_na),
@@ -1197,9 +1197,10 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 		 * If the Perl function returned an arrayref, we pretend that it
 		 * called return_next() for each element of the array, to handle old
 		 * SRFs that didn't know about return_next(). Any other sort of return
-		 * value is an error.
+		 * value is an error, except undef which means return an empty set.
 		 */
-		if (SvTYPE(perlret) == SVt_RV &&
+		if (SvOK(perlret) &&
+			SvTYPE(perlret) == SVt_RV &&
 			SvTYPE(SvRV(perlret)) == SVt_PVAV)
 		{
 			int			i = 0;
@@ -1212,7 +1213,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 				i++;
 			}
 		}
-		else if (SvTYPE(perlret) != SVt_NULL)
+		else if (SvOK(perlret))
 		{
 			ereport(ERROR,
 					(errcode(ERRCODE_DATATYPE_MISMATCH),
@@ -1228,7 +1229,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 		}
 		retval = (Datum) 0;
 	}
-	else if (SvTYPE(perlret) == SVt_NULL)
+	else if (!SvOK(perlret))
 	{
 		/* Return NULL if Perl code returned undef */
 		if (rsi && IsA(rsi, ReturnSetInfo))
@@ -1335,7 +1336,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
 	if (SPI_finish() != SPI_OK_FINISH)
 		elog(ERROR, "SPI_finish() failed");
 
-	if (!(perlret && SvOK(perlret) && SvTYPE(perlret) != SVt_NULL))
+	if (perlret == NULL || !SvOK(perlret))
 	{
 		/* undef result means go ahead with original tuple */
 		TriggerData *trigdata = ((TriggerData *) fcinfo->context);
@@ -1900,7 +1901,7 @@ plperl_return_next(SV *sv)
 		Datum		ret;
 		bool		isNull;
 
-		if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
+		if (SvOK(sv))
 		{
 			char	   *val = SvPV(sv, PL_na);
 
@@ -2292,7 +2293,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
 
 		for (i = 0; i < argc; i++)
 		{
-			if (SvTYPE(argv[i]) != SVt_NULL)
+			if (SvOK(argv[i]))
 			{
 				argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
 												 SvPV(argv[i], PL_na),
@@ -2423,7 +2424,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
 
 		for (i = 0; i < argc; i++)
 		{
-			if (SvTYPE(argv[i]) != SVt_NULL)
+			if (SvOK(argv[i]))
 			{
 				argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
 												 SvPV(argv[i], PL_na),