diff options
| -rw-r--r-- | src/pl/plperl/expected/plperl.out | 36 | ||||
| -rw-r--r-- | src/pl/plperl/plperl.c | 28 | ||||
| -rw-r--r-- | src/pl/plperl/sql/plperl.sql | 32 |
3 files changed, 80 insertions, 16 deletions
diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index 0e2887e86a3..7658f36c25d 100644 --- a/src/pl/plperl/expected/plperl.out +++ b/src/pl/plperl/expected/plperl.out @@ -438,7 +438,7 @@ SELECT array_of_text(); -- Test spi_prepare/spi_exec_prepared/spi_freeplan -- CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$ - my $x = spi_prepare('select $1 AS a', 'INT4'); + my $x = spi_prepare('select $1 AS a', 'INTEGER'); my $q = spi_exec_prepared( $x, $_[0] + 1); spi_freeplan($x); return $q->{rows}->[0]->{a}; @@ -468,3 +468,37 @@ SELECT * from perl_spi_prepared_set(1,2); 4 (2 rows) +-- +-- Test prepare with a type with spaces +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$ + my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION'); + my $q = spi_query_prepared($x,$_[0]); + my $result; + while (defined (my $y = spi_fetchrow($q))) { + $result = $y->{a}; + } + spi_freeplan($x); + return $result; +$$ LANGUAGE plperl; +SELECT perl_spi_prepared_double(4.35) as "double precision"; + double precision +------------------ + 43.5 +(1 row) + +-- +-- Test with a bad type +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$ + my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist'); + my $q = spi_query_prepared($x,$_[0]); + my $result; + while (defined (my $y = spi_fetchrow($q))) { + $result = $y->{a}; + } + spi_freeplan($x); + return $result; +$$ LANGUAGE plperl; +SELECT perl_spi_prepared_bad(4.35) as "double precision"; +ERROR: error from Perl function: type "does_not_exist" does not exist at line 2. diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index e0bbe8fbabf..303024dd70d 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.123 2006/11/21 16:59:02 adunstan Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.124 2007/01/27 01:55:57 adunstan Exp $ * **********************************************************************/ @@ -2128,23 +2128,23 @@ plperl_spi_prepare(char *query, int argc, SV **argv) PG_TRY(); { /************************************************************ - * Lookup the argument types by name in the system cache - * and remember the required information for input conversion + * Resolve argument type names and then look them up by oid + * in the system cache, and remember the required information + * for input conversion. ************************************************************/ for (i = 0; i < argc; i++) { - List *names; - HeapTuple typeTup; - - /* Parse possibly-qualified type name and look it up in pg_type */ - names = stringToQualifiedNameList(SvPV(argv[i], PL_na), - "plperl_spi_prepare"); - typeTup = typenameType(NULL, makeTypeNameFromNameList(names)); - qdesc->argtypes[i] = HeapTupleGetOid(typeTup); - perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput, + Oid typId, typInput, typIOParam; + int32 typmod; + + parseTypeString(SvPV(argv[i], PL_na), &typId, &typmod); + + getTypeInputInfo(typId, &typInput, &typIOParam); + + qdesc->argtypes[i] = typId; + perm_fmgr_info((Form_pg_type) typInput, &(qdesc->arginfuncs[i])); - qdesc->argtypioparams[i] = getTypeIOParam(typeTup); - ReleaseSysCache(typeTup); + qdesc->argtypioparams[i] = typIOParam; } /************************************************************ diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql index e312cd24dc0..4d4348a1f6a 100644 --- a/src/pl/plperl/sql/plperl.sql +++ b/src/pl/plperl/sql/plperl.sql @@ -316,7 +316,7 @@ SELECT array_of_text(); -- Test spi_prepare/spi_exec_prepared/spi_freeplan -- CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$ - my $x = spi_prepare('select $1 AS a', 'INT4'); + my $x = spi_prepare('select $1 AS a', 'INTEGER'); my $q = spi_exec_prepared( $x, $_[0] + 1); spi_freeplan($x); return $q->{rows}->[0]->{a}; @@ -337,3 +337,33 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF $$ LANGUAGE plperl; SELECT * from perl_spi_prepared_set(1,2); +-- +-- Test prepare with a type with spaces +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$ + my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION'); + my $q = spi_query_prepared($x,$_[0]); + my $result; + while (defined (my $y = spi_fetchrow($q))) { + $result = $y->{a}; + } + spi_freeplan($x); + return $result; +$$ LANGUAGE plperl; +SELECT perl_spi_prepared_double(4.35) as "double precision"; + +-- +-- Test with a bad type +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$ + my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist'); + my $q = spi_query_prepared($x,$_[0]); + my $result; + while (defined (my $y = spi_fetchrow($q))) { + $result = $y->{a}; + } + spi_freeplan($x); + return $result; +$$ LANGUAGE plperl; +SELECT perl_spi_prepared_bad(4.35) as "double precision"; + |