diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index f9adb681a6..9b0cfe3815 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.70 2005/03/29 00:17:20 tgl Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.71 2005/04/01 19:34:06 tgl Exp $ * **********************************************************************/ @@ -409,21 +409,16 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo) * NB: copy the result if needed for any great length of time */ static TupleDesc -get_function_tupdesc(Oid result_type, ReturnSetInfo *rsinfo) +get_function_tupdesc(FunctionCallInfo fcinfo) { - if (result_type == RECORDOID) - { - /* We must get the information from call context */ - if (!rsinfo || !IsA(rsinfo, ReturnSetInfo) || - rsinfo->expectedDesc == NULL) - ereport(ERROR, - (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), - errmsg("function returning record called in context " - "that cannot accept type record"))); - return rsinfo->expectedDesc; - } - else /* ordinary composite type */ - return lookup_rowtype_tupdesc(result_type, -1); + TupleDesc result; + + if (get_call_result_type(fcinfo, NULL, &result) != TYPEFUNC_COMPOSITE) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("function returning record called in context " + "that cannot accept type record"))); + return result; } /********************************************************************** @@ -897,8 +892,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) /* Cache a copy of the result's tupdesc and attinmeta */ oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx); - tupdesc = get_function_tupdesc(prodesc->result_oid, - (ReturnSetInfo *) fcinfo->resultinfo); + tupdesc = get_function_tupdesc(fcinfo); tupdesc = CreateTupleDescCopy(tupdesc); funcctx->attinmeta = TupleDescGetAttInMetadata(tupdesc); MemoryContextSwitchTo(oldcontext); @@ -1003,8 +997,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) /* * XXX should cache the attinmeta data instead of recomputing */ - td = get_function_tupdesc(prodesc->result_oid, - (ReturnSetInfo *) fcinfo->resultinfo); + td = get_function_tupdesc(fcinfo); /* td = CreateTupleDescCopy(td); */ attinmeta = TupleDescGetAttInMetadata(td); diff --git a/src/pl/plperl/test/test.expected b/src/pl/plperl/test/test.expected index 38782e8958..340ed638b7 100644 --- a/src/pl/plperl/test/test.expected +++ b/src/pl/plperl/test/test.expected @@ -222,6 +222,61 @@ SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); 3 | Hello | PL/Perl (3 rows) +CREATE OR REPLACE FUNCTION +perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$ + return {f2 => 'hello', f1 => 1, f3 => 'world'}; +$$ LANGUAGE plperl; +SELECT perl_out_params(); + perl_out_params +----------------- + (1,hello,world) +(1 row) + +SELECT * FROM perl_out_params(); + f1 | f2 | f3 +----+-------+------- + 1 | hello | world +(1 row) + +SELECT (perl_out_params()).f2; + f2 +------- + hello +(1 row) + +CREATE OR REPLACE FUNCTION +perl_out_params_set(out f1 integer, out f2 text, out f3 text) +RETURNS SETOF record AS $$ + return [ + { f1 => 1, f2 => 'Hello', f3 => 'World' }, + { f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' }, + { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' } + ]; +$$ LANGUAGE plperl; +SELECT perl_out_params_set(); + perl_out_params_set +---------------------- + (1,Hello,World) + (2,Hello,PostgreSQL) + (3,Hello,PL/Perl) +(3 rows) + +SELECT * FROM perl_out_params_set(); + f1 | f2 | f3 +----+-------+------------ + 1 | Hello | World + 2 | Hello | PostgreSQL + 3 | Hello | PL/Perl +(3 rows) + +SELECT (perl_out_params_set()).f3; + f3 +------------ + World + PostgreSQL + PL/Perl +(3 rows) + CREATE TYPE footype AS (x INTEGER, y INTEGER); CREATE OR REPLACE FUNCTION foo_good() RETURNS SETOF footype AS $$ return [ diff --git a/src/pl/plperl/test/test_queries.sql b/src/pl/plperl/test/test_queries.sql index 37a0ce9160..0cfcd1752d 100644 --- a/src/pl/plperl/test/test_queries.sql +++ b/src/pl/plperl/test/test_queries.sql @@ -135,6 +135,29 @@ SELECT perl_record_set(); SELECT * FROM perl_record_set(); SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); +CREATE OR REPLACE FUNCTION +perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$ + return {f2 => 'hello', f1 => 1, f3 => 'world'}; +$$ LANGUAGE plperl; + +SELECT perl_out_params(); +SELECT * FROM perl_out_params(); +SELECT (perl_out_params()).f2; + +CREATE OR REPLACE FUNCTION +perl_out_params_set(out f1 integer, out f2 text, out f3 text) +RETURNS SETOF record AS $$ + return [ + { f1 => 1, f2 => 'Hello', f3 => 'World' }, + { f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' }, + { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' } + ]; +$$ LANGUAGE plperl; + +SELECT perl_out_params_set(); +SELECT * FROM perl_out_params_set(); +SELECT (perl_out_params_set()).f3; + -- -- Check behavior with erroneous return values --