From b943a8c90ab5774ea871aee878992b084d18bb13 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Tue, 9 Mar 2010 22:34:49 +0000 Subject: [PATCH] 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. --- src/pl/plperl/plperl.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 94ee84a117b..d256a06d46a 100644 --- 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.150.2.5 2010/02/12 04:32:02 adunstan Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.150.2.6 2010/03/09 22:34:49 tgl Exp $ * **********************************************************************/ @@ -793,7 +793,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"))); @@ -1284,7 +1284,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; @@ -1329,7 +1329,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, @@ -1919,7 +1919,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 PL/Perl function "