diff options
| author | Tom Lane <tgl@sss.pgh.pa.us> | 2005-08-12 21:26:32 +0000 |
|---|---|---|
| committer | Tom Lane <tgl@sss.pgh.pa.us> | 2005-08-12 21:26:32 +0000 |
| commit | 65790b9e012b26528dba9ff8e416be55d1a56fa5 (patch) | |
| tree | 9eabaa9aafc2c1659d9029ad557779a11227d724 /src | |
| parent | 7d781c62b1dfe9cabbc57156581799b3150ab317 (diff) | |
| download | postgresql-65790b9e012b26528dba9ff8e416be55d1a56fa5.tar.gz postgresql-65790b9e012b26528dba9ff8e416be55d1a56fa5.zip | |
Un-break plperl for non-set case.
Diffstat (limited to 'src')
| -rw-r--r-- | src/pl/plperl/plperl.c | 26 |
1 files changed, 15 insertions, 11 deletions
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index fbcafe4842e..11c0a5bc384 100644 --- 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.88 2005/08/12 21:09:34 momjian Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.89 2005/08/12 21:26:32 tgl Exp $ * **********************************************************************/ @@ -923,14 +923,16 @@ plperl_func_handler(PG_FUNCTION_ARGS) rsi = (ReturnSetInfo *)fcinfo->resultinfo; - if (!rsi || !IsA(rsi, ReturnSetInfo) || - (rsi->allowedModes & SFRM_Materialize) == 0 || - rsi->expectedDesc == NULL) + if (prodesc->fn_retisset) { - ereport(ERROR, - (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), - errmsg("set-valued function called in context that " - "cannot accept a set"))); + /* Check context before allowing the call to go through */ + if (!rsi || !IsA(rsi, ReturnSetInfo) || + (rsi->allowedModes & SFRM_Materialize) == 0 || + rsi->expectedDesc == NULL) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("set-valued function called in context that " + "cannot accept a set"))); } perlret = plperl_call_perl_func(prodesc, fcinfo); @@ -944,12 +946,14 @@ plperl_func_handler(PG_FUNCTION_ARGS) if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); - if (prodesc->fn_retisset) + if (prodesc->fn_retisset) { - /* 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 SRFs that didn't know about return_next(). Any other sort - * of return value is an error. */ + * of return value is an error. + */ if (SvTYPE(perlret) == SVt_RV && SvTYPE(SvRV(perlret)) == SVt_PVAV) { |