Commit 3cabc675 authored by Tom Lane's avatar Tom Lane

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.
parent 7c07b136
/********************************************************************** /**********************************************************************
* plperl.c - perl as a procedural language for PostgreSQL * 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) ...@@ -547,7 +547,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
(errcode(ERRCODE_UNDEFINED_COLUMN), (errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("Perl hash contains nonexistent column \"%s\"", errmsg("Perl hash contains nonexistent column \"%s\"",
key))); key)));
if (SvOK(val) && SvTYPE(val) != SVt_NULL) if (SvOK(val))
values[attn - 1] = SvPV(val, PL_na); values[attn - 1] = SvPV(val, PL_na);
} }
hv_iterinit(perlhash); hv_iterinit(perlhash);
...@@ -743,7 +743,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ...@@ -743,7 +743,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
&typinput, &typioparam); &typinput, &typioparam);
fmgr_info(typinput, &finfo); fmgr_info(typinput, &finfo);
atttypmod = tupdesc->attrs[attn - 1]->atttypmod; atttypmod = tupdesc->attrs[attn - 1]->atttypmod;
if (SvOK(val) && SvTYPE(val) != SVt_NULL) if (SvOK(val))
{ {
modvalues[slotsused] = InputFunctionCall(&finfo, modvalues[slotsused] = InputFunctionCall(&finfo,
SvPV(val, PL_na), SvPV(val, PL_na),
...@@ -1197,9 +1197,10 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -1197,9 +1197,10 @@ plperl_func_handler(PG_FUNCTION_ARGS)
* If the Perl function returned an arrayref, we pretend that it * If the Perl function returned an arrayref, we pretend that it
* called return_next() for each element of the array, to handle old * 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 * 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) SvTYPE(SvRV(perlret)) == SVt_PVAV)
{ {
int i = 0; int i = 0;
...@@ -1212,7 +1213,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -1212,7 +1213,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
i++; i++;
} }
} }
else if (SvTYPE(perlret) != SVt_NULL) else if (SvOK(perlret))
{ {
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_DATATYPE_MISMATCH),
...@@ -1228,7 +1229,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -1228,7 +1229,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
} }
retval = (Datum) 0; retval = (Datum) 0;
} }
else if (SvTYPE(perlret) == SVt_NULL) else if (!SvOK(perlret))
{ {
/* Return NULL if Perl code returned undef */ /* Return NULL if Perl code returned undef */
if (rsi && IsA(rsi, ReturnSetInfo)) if (rsi && IsA(rsi, ReturnSetInfo))
...@@ -1335,7 +1336,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) ...@@ -1335,7 +1336,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
if (SPI_finish() != SPI_OK_FINISH) if (SPI_finish() != SPI_OK_FINISH)
elog(ERROR, "SPI_finish() failed"); 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 */ /* undef result means go ahead with original tuple */
TriggerData *trigdata = ((TriggerData *) fcinfo->context); TriggerData *trigdata = ((TriggerData *) fcinfo->context);
...@@ -1900,7 +1901,7 @@ plperl_return_next(SV *sv) ...@@ -1900,7 +1901,7 @@ plperl_return_next(SV *sv)
Datum ret; Datum ret;
bool isNull; bool isNull;
if (SvOK(sv) && SvTYPE(sv) != SVt_NULL) if (SvOK(sv))
{ {
char *val = SvPV(sv, PL_na); char *val = SvPV(sv, PL_na);
...@@ -2292,7 +2293,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv) ...@@ -2292,7 +2293,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
for (i = 0; i < argc; i++) for (i = 0; i < argc; i++)
{ {
if (SvTYPE(argv[i]) != SVt_NULL) if (SvOK(argv[i]))
{ {
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i], argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
SvPV(argv[i], PL_na), SvPV(argv[i], PL_na),
...@@ -2423,7 +2424,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv) ...@@ -2423,7 +2424,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
for (i = 0; i < argc; i++) for (i = 0; i < argc; i++)
{ {
if (SvTYPE(argv[i]) != SVt_NULL) if (SvOK(argv[i]))
{ {
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i], argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
SvPV(argv[i], PL_na), SvPV(argv[i], PL_na),
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment