Fix incorrect tests for undef Perl values in some places in plperl.c.

tglsfdc · tglsfdc · commit 3cabc675ab40 · 2007-06-28T17:49:59.000Z
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.
diff --git 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),

Original file line number	Diff line number	Diff line change
`@@ -1,7 +1,7 @@`
`1`	`1`	`/**********************************************************************`
`2`	`2`	`* plperl.c - perl as a procedural language for PostgreSQL`
`3`	`3`	`*`
`4`		`- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.128 2007/04/02 03:49:41 tgl Exp $`
	`4`	`+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.129 2007/06/28 17:49:59 tgl Exp $`
`5`	`5`	`*`
`6`	`6`	`**********************************************************************/`
`7`	`7`
`@@ -547,7 +547,7 @@ plperl_build_tuple_result(HV perlhash, AttInMetadata attinmeta)`
`547`	`547`	`(errcode(ERRCODE_UNDEFINED_COLUMN),`
`548`	`548`	`errmsg("Perl hash contains nonexistent column \"%s\"",`
`549`	`549`	`key)));`
`550`		`- if (SvOK(val) && SvTYPE(val) != SVt_NULL)`
	`550`	`+ if (SvOK(val))`
`551`	`551`	`values[attn - 1] = SvPV(val, PL_na);`
`552`	`552`	`}`
`553`	`553`	`hv_iterinit(perlhash);`
`@@ -743,7 +743,7 @@ plperl_modify_tuple(HV hvTD, TriggerData tdata, HeapTuple otup)`
`743`	`743`	`&typinput, &typioparam);`
`744`	`744`	`fmgr_info(typinput, &finfo);`
`745`	`745`	`atttypmod = tupdesc->attrs[attn - 1]->atttypmod;`
`746`		`- if (SvOK(val) && SvTYPE(val) != SVt_NULL)`
	`746`	`+ if (SvOK(val))`
`747`	`747`	`{`
`748`	`748`	`modvalues[slotsused] = InputFunctionCall(&finfo,`
`749`	`749`	`SvPV(val, PL_na),`
`@@ -1197,9 +1197,10 @@ plperl_func_handler(PG_FUNCTION_ARGS)`
`1197`	`1197`	`* If the Perl function returned an arrayref, we pretend that it`
`1198`	`1198`	`* called return_next() for each element of the array, to handle old`
`1199`	`1199`	`* SRFs that didn't know about return_next(). Any other sort of return`
`1200`		`- * value is an error.`
	`1200`	`+ * value is an error, except undef which means return an empty set.`
`1201`	`1201`	`*/`
`1202`		`- if (SvTYPE(perlret) == SVt_RV &&`
	`1202`	`+ if (SvOK(perlret) &&`
	`1203`	`+ SvTYPE(perlret) == SVt_RV &&`
`1203`	`1204`	`SvTYPE(SvRV(perlret)) == SVt_PVAV)`
`1204`	`1205`	`{`
`1205`	`1206`	`int i = 0;`
`@@ -1212,7 +1213,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)`
`1212`	`1213`	`i++;`
`1213`	`1214`	`}`
`1214`	`1215`	`}`
`1215`		`- else if (SvTYPE(perlret) != SVt_NULL)`
	`1216`	`+ else if (SvOK(perlret))`
`1216`	`1217`	`{`
`1217`	`1218`	`ereport(ERROR,`
`1218`	`1219`	`(errcode(ERRCODE_DATATYPE_MISMATCH),`
`@@ -1228,7 +1229,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)`
`1228`	`1229`	`}`
`1229`	`1230`	`retval = (Datum) 0;`
`1230`	`1231`	`}`
`1231`		`- else if (SvTYPE(perlret) == SVt_NULL)`
	`1232`	`+ else if (!SvOK(perlret))`
`1232`	`1233`	`{`
`1233`	`1234`	`/* Return NULL if Perl code returned undef */`
`1234`	`1235`	`if (rsi && IsA(rsi, ReturnSetInfo))`
`@@ -1335,7 +1336,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)`
`1335`	`1336`	`if (SPI_finish() != SPI_OK_FINISH)`
`1336`	`1337`	`elog(ERROR, "SPI_finish() failed");`
`1337`	`1338`
`1338`		`- if (!(perlret && SvOK(perlret) && SvTYPE(perlret) != SVt_NULL))`
	`1339`	`+ if (perlret == NULL \|\| !SvOK(perlret))`
`1339`	`1340`	`{`
`1340`	`1341`	`/* undef result means go ahead with original tuple */`
`1341`	`1342`	`TriggerData trigdata = ((TriggerData ) fcinfo->context);`
`@@ -1900,7 +1901,7 @@ plperl_return_next(SV *sv)`
`1900`	`1901`	`Datum ret;`
`1901`	`1902`	`bool isNull;`
`1902`	`1903`
`1903`		`- if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)`
	`1904`	`+ if (SvOK(sv))`
`1904`	`1905`	`{`
`1905`	`1906`	`char *val = SvPV(sv, PL_na);`
`1906`	`1907`
`@@ -2292,7 +2293,7 @@ plperl_spi_exec_prepared(char query, HV attr, int argc, SV **argv)`
`2292`	`2293`
`2293`	`2294`	`for (i = 0; i < argc; i++)`
`2294`	`2295`	`{`
`2295`		`- if (SvTYPE(argv[i]) != SVt_NULL)`
	`2296`	`+ if (SvOK(argv[i]))`
`2296`	`2297`	`{`
`2297`	`2298`	`argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],`
`2298`	`2299`	`SvPV(argv[i], PL_na),`
`@@ -2423,7 +2424,7 @@ plperl_spi_query_prepared(char query, int argc, SV *argv)`
`2423`	`2424`
`2424`	`2425`	`for (i = 0; i < argc; i++)`
`2425`	`2426`	`{`
`2426`		`- if (SvTYPE(argv[i]) != SVt_NULL)`
	`2427`	`+ if (SvOK(argv[i]))`
`2427`	`2428`	`{`
`2428`	`2429`	`argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],`
`2429`	`2430`	`SvPV(argv[i], PL_na),`