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.

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index ed03cc0359e11ad53c7bfa9b9836533c82de799f..356f9f1231dbb396fcbbc3496a621f35f1d11537 100644 (file)
--- 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.5 2006/01/28 16:21:33 adunstan Exp $
+ *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.94.2.6 2007/06/28 17:50:17 tgl Exp $
  *
  **********************************************************************/
 
@@ -435,7 +435,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);
@@ -616,7 +616,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
                                        (errcode(ERRCODE_UNDEFINED_COLUMN),
                                         errmsg("Perl hash contains nonexistent column \"%s\"",
                                                        key)));
-               if (SvOK(val) && SvTYPE(val) != SVt_NULL)
+               if (SvOK(val))
                {
                        Oid                     typinput;
                        Oid                     typioparam;
@@ -1046,9 +1046,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;
@@ -1061,7 +1062,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
                                i++;
                        }
                }
-               else if (SvTYPE(perlret) != SVt_NULL)
+               else if (SvOK(perlret))
                {
                        ereport(ERROR,
                                        (errcode(ERRCODE_DATATYPE_MISMATCH),
@@ -1077,7 +1078,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))
@@ -1180,7 +1181,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);
@@ -1744,7 +1745,7 @@ plperl_return_next(SV *sv)
                Datum           ret = (Datum) 0;
                bool            isNull = true;
 
-               if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
+               if (SvOK(sv))
                {
                        char       *val = SvPV(sv, PL_na);