From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Tue, 9 Mar 2010 22:35:16 +0000 (+0000)
Subject: Use SvROK(sv) rather than directly checking SvTYPE(sv) == SVt_RV in plperl.
X-Git-Tag: REL8_1_20~2
X-Git-Url: http://git.postgresql.org/gitweb/?a=commitdiff_plain;h=a38c09f43dabbdb7545df7a8c705887b9274e654;p=users%2Fgsingh%2Fpostgres.git

Use SvROK(sv) rather than directly checking SvTYPE(sv) == SVt_RV in plperl.
The latter is considered unwarranted chumminess with the implementation,
and can lead to crashes with recent Perl versions.

Report and fix by Tim Bunce.  Back-patch to all versions containing the
questionable coding pattern.
---

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index bbe1424e69..a4c05d13cc 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *	  ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.94.2.14 2009/12/29 17:41:35 heikki Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.94.2.15 2010/03/09 22:35:16 tgl Exp $
  *
  **********************************************************************/
 
@@ -653,7 +653,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
 		ereport(ERROR,
 				(errcode(ERRCODE_UNDEFINED_COLUMN),
 				 errmsg("$_TD->{new} does not exist")));
-	if (!SvOK(*svp) || SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV)
+	if (!SvOK(*svp) || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV)
 		ereport(ERROR,
 				(errcode(ERRCODE_DATATYPE_MISMATCH),
 				 errmsg("$_TD->{new} is not a hash reference")));
@@ -1107,7 +1107,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 		 * value is an error, except undef which means return an empty set.
 		 */
 		if (SvOK(perlret) &&
-			SvTYPE(perlret) == SVt_RV &&
+			SvROK(perlret) &&
 			SvTYPE(SvRV(perlret)) == SVt_PVAV)
 		{
 			int			i = 0;
@@ -1151,7 +1151,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 		AttInMetadata *attinmeta;
 		HeapTuple	tup;
 
-		if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV ||
+		if (!SvOK(perlret) || !SvROK(perlret) ||
 			SvTYPE(SvRV(perlret)) != SVt_PVHV)
 		{
 			ereport(ERROR,
@@ -1734,7 +1734,7 @@ plperl_return_next(SV *sv)
 				 errmsg("cannot use return_next in a non-SETOF function")));
 
 	if (prodesc->fn_retistuple &&
-		!(SvOK(sv) && SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVHV))
+		!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
 		ereport(ERROR,
 				(errcode(ERRCODE_DATATYPE_MISMATCH),
 				 errmsg("setof-composite-returning Perl function "