Skip to content

Commit 175a242

Browse files
adunstanadunstan
committed
Allow args to spi_prepare to be standard type aliaes as well as those known in pg_type. Fixes bug #2917. Add some regression tests for these cases.
1 parent 27552ce commit 175a242

File tree

3 files changed

+80
-16
lines changed

3 files changed

+80
-16
lines changed

‎src/pl/plperl/expected/plperl.out

Lines changed: 35 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -438,7 +438,7 @@ SELECT array_of_text();
438438
-- Test spi_prepare/spi_exec_prepared/spi_freeplan
439439
--
440440
CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
441-
my $x = spi_prepare('select $1 AS a', 'INT4');
441+
my $x = spi_prepare('select $1 AS a', 'INTEGER');
442442
my $q = spi_exec_prepared( $x, $_[0] + 1);
443443
spi_freeplan($x);
444444
return $q->{rows}->[0]->{a};
@@ -468,3 +468,37 @@ SELECT * from perl_spi_prepared_set(1,2);
468468
4
469469
(2 rows)
470470

471+
--
472+
-- Test prepare with a type with spaces
473+
--
474+
CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$
475+
my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION');
476+
my $q = spi_query_prepared($x,$_[0]);
477+
my $result;
478+
while (defined (my $y = spi_fetchrow($q))) {
479+
$result = $y->{a};
480+
}
481+
spi_freeplan($x);
482+
return $result;
483+
$$ LANGUAGE plperl;
484+
SELECT perl_spi_prepared_double(4.35) as "double precision";
485+
double precision
486+
------------------
487+
43.5
488+
(1 row)
489+
490+
--
491+
-- Test with a bad type
492+
--
493+
CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$
494+
my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist');
495+
my $q = spi_query_prepared($x,$_[0]);
496+
my $result;
497+
while (defined (my $y = spi_fetchrow($q))) {
498+
$result = $y->{a};
499+
}
500+
spi_freeplan($x);
501+
return $result;
502+
$$ LANGUAGE plperl;
503+
SELECT perl_spi_prepared_bad(4.35) as "double precision";
504+
ERROR: error from Perl function: type "does_not_exist" does not exist at line 2.

‎src/pl/plperl/plperl.c

Lines changed: 14 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
/**********************************************************************
22
* plperl.c - perl as a procedural language for PostgreSQL
33
*
4-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.123 2006/11/21 16:59:02 adunstan Exp $
4+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.124 2007/01/27 01:55:57 adunstan Exp $
55
*
66
**********************************************************************/
77

@@ -2128,23 +2128,23 @@ plperl_spi_prepare(char *query, int argc, SV **argv)
21282128
PG_TRY();
21292129
{
21302130
/************************************************************
2131-
* Lookup the argument types by name in the system cache
2132-
* and remember the required information for input conversion
2131+
* Resolve argument type names and then look them up by oid
2132+
* in the system cache, and remember the required information
2133+
* for input conversion.
21332134
************************************************************/
21342135
for (i = 0; i < argc; i++)
21352136
{
2136-
List *names;
2137-
HeapTuple typeTup;
2138-
2139-
/* Parse possibly-qualified type name and look it up in pg_type */
2140-
names = stringToQualifiedNameList(SvPV(argv[i], PL_na),
2141-
"plperl_spi_prepare");
2142-
typeTup = typenameType(NULL, makeTypeNameFromNameList(names));
2143-
qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
2144-
perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
2137+
Oid typId, typInput, typIOParam;
2138+
int32 typmod;
2139+
2140+
parseTypeString(SvPV(argv[i], PL_na), &typId, &typmod);
2141+
2142+
getTypeInputInfo(typId, &typInput, &typIOParam);
2143+
2144+
qdesc->argtypes[i] = typId;
2145+
perm_fmgr_info((Form_pg_type) typInput,
21452146
&(qdesc->arginfuncs[i]));
2146-
qdesc->argtypioparams[i] = getTypeIOParam(typeTup);
2147-
ReleaseSysCache(typeTup);
2147+
qdesc->argtypioparams[i] = typIOParam;
21482148
}
21492149

21502150
/************************************************************

‎src/pl/plperl/sql/plperl.sql

Lines changed: 31 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -316,7 +316,7 @@ SELECT array_of_text();
316316
-- Test spi_prepare/spi_exec_prepared/spi_freeplan
317317
--
318318
CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
319-
my $x = spi_prepare('select $1 AS a', 'INT4');
319+
my $x = spi_prepare('select $1 AS a', 'INTEGER');
320320
my $q = spi_exec_prepared( $x, $_[0] + 1);
321321
spi_freeplan($x);
322322
return $q->{rows}->[0]->{a};
@@ -337,3 +337,33 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF
337337
$$ LANGUAGE plperl;
338338
SELECT * from perl_spi_prepared_set(1,2);
339339

340+
--
341+
-- Test prepare with a type with spaces
342+
--
343+
CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$
344+
my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION');
345+
my $q = spi_query_prepared($x,$_[0]);
346+
my $result;
347+
while (defined (my $y = spi_fetchrow($q))) {
348+
$result = $y->{a};
349+
}
350+
spi_freeplan($x);
351+
return $result;
352+
$$ LANGUAGE plperl;
353+
SELECT perl_spi_prepared_double(4.35) as "double precision";
354+
355+
--
356+
-- Test with a bad type
357+
--
358+
CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$
359+
my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist');
360+
my $q = spi_query_prepared($x,$_[0]);
361+
my $result;
362+
while (defined (my $y = spi_fetchrow($q))) {
363+
$result = $y->{a};
364+
}
365+
spi_freeplan($x);
366+
return $result;
367+
$$ LANGUAGE plperl;
368+
SELECT perl_spi_prepared_bad(4.35) as "double precision";
369+

0 commit comments

Comments
 (0)