git.postgresql.org Git - postgresql.git/commitdiff

diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out

index 0e2887e86a34e0c790e4f4597b2c45993ce157a4..7658f36c25d584b813ae1b0320fd0248966bf2e2 100644 (file)

--- a/src/pl/plperl/expected/plperl.out

+++ b/src/pl/plperl/expected/plperl.out

-- 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};

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 e0bbe8fbabf1b1d23db63ddf7e153300e1773f06..303024dd70d893300b25736579d70655a8c5fcce 100644 (file)

--- a/src/pl/plperl/plperl.c

+++ b/src/pl/plperl/plperl.c

/**********************************************************************

* 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 $

*

**********************************************************************/

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 e312cd24dc07eadbbbd9663256efde1657708088..4d4348a1f6af5872475c62e77b0a9b8e64b8bafb 100644 (file)

--- a/src/pl/plperl/sql/plperl.sql

+++ b/src/pl/plperl/sql/plperl.sql

-- 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};

$$ 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";

+