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 35b61b5b59d41dc82b310bff0363dbac1ddd054b..b08d709352ee7ab3a973d1d42689c000a704c329 100644 (file)
--- 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.136.2.7 2010/02/12 04:32:56 adunstan Exp $
+ *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.136.2.8 2010/03/09 22:34:58 tgl Exp $
  *
  **********************************************************************/
 
@@ -778,7 +778,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")));
@@ -1269,7 +1269,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;
@@ -1314,7 +1314,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,
@@ -1904,7 +1904,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 "