Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit510f350

Browse files
committed
Provide regression testing for plperlu, and for plperl+plperlu interaction.
The latter are only run if the platform can run both interpreters in thesame backend.
1 parent0346442 commit510f350

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/0903:53:40 tgl Exp $
2+
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.40 2010/01/0915: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

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;
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 REPLACEFUNCTIONbar() RETURNSintegerAS $$
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 REPLACEFUNCTIONfoo() RETURNSintegerAS $$
10+
spi_exec_query("SELECT * FROM bar()");
11+
return1;
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 REPLACEFUNCTIONperl_unicode_regex(text) RETURNSINTEGERAS $$
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 =$pleq'tcl' ?'pltcl' :$pl;
152152
nextunless-d"../../$Config/$lang";
153153
$lang ='plpythonu'if$langeq'plpython';
154+
my@lang_args = ("--load-language=$lang" );
154155
chdir$pl;
156+
my@tests = fetchTests();
157+
if ($langeq'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)
[8]ページ先頭
©2009-2025 Movatter.jp