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.
This commit is contained in:
parent
d733417906
commit
f446c28db3
@ -1,7 +1,7 @@
|
|||||||
/**********************************************************************
|
/**********************************************************************
|
||||||
* 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.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,
|
ereport(ERROR,
|
||||||
(errcode(ERRCODE_UNDEFINED_COLUMN),
|
(errcode(ERRCODE_UNDEFINED_COLUMN),
|
||||||
errmsg("$_TD->{new} does not exist")));
|
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,
|
ereport(ERROR,
|
||||||
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
||||||
errmsg("$_TD->{new} is not a hash reference")));
|
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.
|
* value is an error, except undef which means return an empty set.
|
||||||
*/
|
*/
|
||||||
if (SvOK(perlret) &&
|
if (SvOK(perlret) &&
|
||||||
SvTYPE(perlret) == SVt_RV &&
|
SvROK(perlret) &&
|
||||||
SvTYPE(SvRV(perlret)) == SVt_PVAV)
|
SvTYPE(SvRV(perlret)) == SVt_PVAV)
|
||||||
{
|
{
|
||||||
int i = 0;
|
int i = 0;
|
||||||
@ -1314,7 +1314,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
|
|||||||
AttInMetadata *attinmeta;
|
AttInMetadata *attinmeta;
|
||||||
HeapTuple tup;
|
HeapTuple tup;
|
||||||
|
|
||||||
if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV ||
|
if (!SvOK(perlret) || !SvROK(perlret) ||
|
||||||
SvTYPE(SvRV(perlret)) != SVt_PVHV)
|
SvTYPE(SvRV(perlret)) != SVt_PVHV)
|
||||||
{
|
{
|
||||||
ereport(ERROR,
|
ereport(ERROR,
|
||||||
@ -1904,7 +1904,7 @@ plperl_return_next(SV *sv)
|
|||||||
errmsg("cannot use return_next in a non-SETOF function")));
|
errmsg("cannot use return_next in a non-SETOF function")));
|
||||||
|
|
||||||
if (prodesc->fn_retistuple &&
|
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,
|
ereport(ERROR,
|
||||||
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
||||||
errmsg("setof-composite-returning Perl function "
|
errmsg("setof-composite-returning Perl function "
|
||||||
|
Loading…
x
Reference in New Issue
Block a user