Skip to content

Commit 510f350

Browse files
adunstanadunstan
committed
Provide regression testing for plperlu, and for plperl+plperlu interaction.
The latter are only run if the platform can run both interpreters in the same backend.
1 parent 0346442 commit 510f350

File tree

6 files changed

+82
-6
lines changed

6 files changed

+82
-6
lines changed

‎src/pl/plperl/GNUmakefile

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
# Makefile for PL/Perl
2-
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.39 2010/01/09 03:53:40 tgl Exp $
2+
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.40 2010/01/09 15:25:41 adunstan Exp $
33

44
subdir = src/pl/plperl
55
top_builddir = ../../..
@@ -40,8 +40,15 @@ PERLCHUNKS = plc_perlboot.pl plc_safe_bad.pl plc_safe_ok.pl
4040

4141
SHLIB_LINK = $(perl_embed_ldflags)
4242

43-
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl
44-
REGRESS = plperl plperl_trigger plperl_shared plperl_elog
43+
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
44+
REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperlu
45+
# if Perl can support two interpreters in one backend,
46+
# test plperl-and-plperlu cases
47+
ifneq ($(PERL),)
48+
ifeq ($(shell $(PERL) -V:usemultiplicity), usemultiplicity='define';)
49+
REGRESS += plperl_plperlu
50+
endif
51+
endif
4552
# where to find psql for running the tests
4653
PSQLDIR = $(bindir)
4754

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

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
-- test plperl/plperlu interaction
2+
CREATE OR REPLACE FUNCTION bar() RETURNS integer AS $$
3+
#die 'BANG!'; # causes server process to exit(2)
4+
# alternative - causes server process to exit(255)
5+
spi_exec_query("invalid sql statement");
6+
$$ language plperl; -- plperl or plperlu
7+
8+
CREATE OR REPLACE FUNCTION foo() RETURNS integer AS $$
9+
spi_exec_query("SELECT * FROM bar()");
10+
return 1;
11+
$$ LANGUAGE plperlu; -- must be opposite to language of bar
12+
13+
SELECT * FROM bar(); -- throws exception normally
14+
ERROR: syntax error at or near "invalid" at line 4.
15+
CONTEXT: PL/Perl function "bar"
16+
SELECT * FROM foo(); -- used to cause backend crash
17+
ERROR: syntax error at or near "invalid" at line 4. at line 2.
18+
CONTEXT: PL/Perl function "foo"

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

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
-- Use ONLY plperlu tests here. For plperl/plerlu combined tests
2+
-- see plperl_plperlu.sql
3+
--
4+
-- Test compilation of unicode regex - regardless of locale.
5+
-- This code fails in plain plperl in a non-UTF8 database.
6+
--
7+
CREATE OR REPLACE FUNCTION perl_unicode_regex(text) RETURNS INTEGER AS $$
8+
return ($_[0] =~ /\x{263A}|happy/i) ? 1 : 0; # unicode smiley
9+
$$ LANGUAGE plperlu;

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

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
-- test plperl/plperlu interaction
2+
3+
CREATE OR REPLACE FUNCTION bar() RETURNS integer AS $$
4+
#die 'BANG!'; # causes server process to exit(2)
5+
# alternative - causes server process to exit(255)
6+
spi_exec_query("invalid sql statement");
7+
$$ language plperl; -- plperl or plperlu
8+
9+
CREATE OR REPLACE FUNCTION foo() RETURNS integer AS $$
10+
spi_exec_query("SELECT * FROM bar()");
11+
return 1;
12+
$$ LANGUAGE plperlu; -- must be opposite to language of bar
13+
14+
SELECT * FROM bar(); -- throws exception normally
15+
SELECT * FROM foo(); -- used to cause backend crash
16+
17+

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

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
-- Use ONLY plperlu tests here. For plperl/plerlu combined tests
2+
-- see plperl_plperlu.sql
3+
4+
--
5+
-- Test compilation of unicode regex - regardless of locale.
6+
-- This code fails in plain plperl in a non-UTF8 database.
7+
--
8+
CREATE OR REPLACE FUNCTION perl_unicode_regex(text) RETURNS INTEGER AS $$
9+
return ($_[0] =~ /\x{263A}|happy/i) ? 1 : 0; # unicode smiley
10+
$$ LANGUAGE plperlu;

‎src/tools/msvc/vcregress.pl

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11

22
# -*-perl-*- hey - emacs - this is a perl file
33

4-
# $PostgreSQL: pgsql/src/tools/msvc/vcregress.pl,v 1.12 2009/12/19 02:44:06 tgl Exp $
4+
# $PostgreSQL: pgsql/src/tools/msvc/vcregress.pl,v 1.13 2010/01/09 15:25:41 adunstan Exp $
55

66
use strict;
77

@@ -151,14 +151,29 @@ sub plcheck
151151
my $lang = $pl eq 'tcl' ? 'pltcl' : $pl;
152152
next unless -d "../../$Config/$lang";
153153
$lang = 'plpythonu' if $lang eq 'plpython';
154+
my @lang_args = ( "--load-language=$lang" );
154155
chdir $pl;
156+
my @tests = fetchTests();
157+
if ($lang eq 'plperl')
158+
{
159+
# run both trusted and untrusted perl tests
160+
push (@lang_args, "--load-language=plperlu");
161+
162+
# assume we're using this perl to built postgres
163+
# test if we can run two interpreters in one backend, and if so
164+
# run the trusted/untrusted interaction tests
165+
use Config;
166+
if ($Config{usemultiplicity} eq 'define')
167+
{
168+
push(@tests,'plperl_plperlu');
169+
}
170+
}
155171
print "============================================================\n";
156172
print "Checking $lang\n";
157-
my @tests = fetchTests();
158173
my @args = (
159174
"../../../$Config/pg_regress/pg_regress",
160175
"--psqldir=../../../$Config/psql",
161-
"--dbname=pl_regression","--load-language=$lang",@tests
176+
"--dbname=pl_regression",@lang_args,@tests
162177
);
163178
system(@args);
164179
my $status = $? >> 8;

0 commit comments

Comments
 (0)