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.
This commit is contained in:
parent
0346442b5d
commit
510f3502eb
@ -1,5 +1,5 @@
|
||||
# Makefile for PL/Perl
|
||||
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.39 2010/01/09 03:53:40 tgl Exp $
|
||||
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.40 2010/01/09 15:25:41 adunstan Exp $
|
||||
|
||||
subdir = src/pl/plperl
|
||||
top_builddir = ../../..
|
||||
@ -40,8 +40,15 @@ PERLCHUNKS = plc_perlboot.pl plc_safe_bad.pl plc_safe_ok.pl
|
||||
|
||||
SHLIB_LINK = $(perl_embed_ldflags)
|
||||
|
||||
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl
|
||||
REGRESS = plperl plperl_trigger plperl_shared plperl_elog
|
||||
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
|
||||
REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperlu
|
||||
# if Perl can support two interpreters in one backend,
|
||||
# test plperl-and-plperlu cases
|
||||
ifneq ($(PERL),)
|
||||
ifeq ($(shell $(PERL) -V:usemultiplicity), usemultiplicity='define';)
|
||||
REGRESS += plperl_plperlu
|
||||
endif
|
||||
endif
|
||||
# where to find psql for running the tests
|
||||
PSQLDIR = $(bindir)
|
||||
|
||||
|
18
src/pl/plperl/expected/plperl_plperlu.out
Normal file
18
src/pl/plperl/expected/plperl_plperlu.out
Normal file
@ -0,0 +1,18 @@
|
||||
-- test plperl/plperlu interaction
|
||||
CREATE OR REPLACE FUNCTION bar() RETURNS integer AS $$
|
||||
#die 'BANG!'; # causes server process to exit(2)
|
||||
# alternative - causes server process to exit(255)
|
||||
spi_exec_query("invalid sql statement");
|
||||
$$ language plperl; -- plperl or plperlu
|
||||
|
||||
CREATE OR REPLACE FUNCTION foo() RETURNS integer AS $$
|
||||
spi_exec_query("SELECT * FROM bar()");
|
||||
return 1;
|
||||
$$ LANGUAGE plperlu; -- must be opposite to language of bar
|
||||
|
||||
SELECT * FROM bar(); -- throws exception normally
|
||||
ERROR: syntax error at or near "invalid" at line 4.
|
||||
CONTEXT: PL/Perl function "bar"
|
||||
SELECT * FROM foo(); -- used to cause backend crash
|
||||
ERROR: syntax error at or near "invalid" at line 4. at line 2.
|
||||
CONTEXT: PL/Perl function "foo"
|
9
src/pl/plperl/expected/plperlu.out
Normal file
9
src/pl/plperl/expected/plperlu.out
Normal file
@ -0,0 +1,9 @@
|
||||
-- Use ONLY plperlu tests here. For plperl/plerlu combined tests
|
||||
-- see plperl_plperlu.sql
|
||||
--
|
||||
-- Test compilation of unicode regex - regardless of locale.
|
||||
-- This code fails in plain plperl in a non-UTF8 database.
|
||||
--
|
||||
CREATE OR REPLACE FUNCTION perl_unicode_regex(text) RETURNS INTEGER AS $$
|
||||
return ($_[0] =~ /\x{263A}|happy/i) ? 1 : 0; # unicode smiley
|
||||
$$ LANGUAGE plperlu;
|
17
src/pl/plperl/sql/plperl_plperlu.sql
Normal file
17
src/pl/plperl/sql/plperl_plperlu.sql
Normal file
@ -0,0 +1,17 @@
|
||||
-- test plperl/plperlu interaction
|
||||
|
||||
CREATE OR REPLACE FUNCTION bar() RETURNS integer AS $$
|
||||
#die 'BANG!'; # causes server process to exit(2)
|
||||
# alternative - causes server process to exit(255)
|
||||
spi_exec_query("invalid sql statement");
|
||||
$$ language plperl; -- plperl or plperlu
|
||||
|
||||
CREATE OR REPLACE FUNCTION foo() RETURNS integer AS $$
|
||||
spi_exec_query("SELECT * FROM bar()");
|
||||
return 1;
|
||||
$$ LANGUAGE plperlu; -- must be opposite to language of bar
|
||||
|
||||
SELECT * FROM bar(); -- throws exception normally
|
||||
SELECT * FROM foo(); -- used to cause backend crash
|
||||
|
||||
|
10
src/pl/plperl/sql/plperlu.sql
Normal file
10
src/pl/plperl/sql/plperlu.sql
Normal file
@ -0,0 +1,10 @@
|
||||
-- Use ONLY plperlu tests here. For plperl/plerlu combined tests
|
||||
-- see plperl_plperlu.sql
|
||||
|
||||
--
|
||||
-- Test compilation of unicode regex - regardless of locale.
|
||||
-- This code fails in plain plperl in a non-UTF8 database.
|
||||
--
|
||||
CREATE OR REPLACE FUNCTION perl_unicode_regex(text) RETURNS INTEGER AS $$
|
||||
return ($_[0] =~ /\x{263A}|happy/i) ? 1 : 0; # unicode smiley
|
||||
$$ LANGUAGE plperlu;
|
@ -1,7 +1,7 @@
|
||||
|
||||
# -*-perl-*- hey - emacs - this is a perl file
|
||||
|
||||
# $PostgreSQL: pgsql/src/tools/msvc/vcregress.pl,v 1.12 2009/12/19 02:44:06 tgl Exp $
|
||||
# $PostgreSQL: pgsql/src/tools/msvc/vcregress.pl,v 1.13 2010/01/09 15:25:41 adunstan Exp $
|
||||
|
||||
use strict;
|
||||
|
||||
@ -151,14 +151,29 @@ sub plcheck
|
||||
my $lang = $pl eq 'tcl' ? 'pltcl' : $pl;
|
||||
next unless -d "../../$Config/$lang";
|
||||
$lang = 'plpythonu' if $lang eq 'plpython';
|
||||
my @lang_args = ( "--load-language=$lang" );
|
||||
chdir $pl;
|
||||
my @tests = fetchTests();
|
||||
if ($lang eq 'plperl')
|
||||
{
|
||||
# run both trusted and untrusted perl tests
|
||||
push (@lang_args, "--load-language=plperlu");
|
||||
|
||||
# assume we're using this perl to built postgres
|
||||
# test if we can run two interpreters in one backend, and if so
|
||||
# run the trusted/untrusted interaction tests
|
||||
use Config;
|
||||
if ($Config{usemultiplicity} eq 'define')
|
||||
{
|
||||
push(@tests,'plperl_plperlu');
|
||||
}
|
||||
}
|
||||
print "============================================================\n";
|
||||
print "Checking $lang\n";
|
||||
my @tests = fetchTests();
|
||||
my @args = (
|
||||
"../../../$Config/pg_regress/pg_regress",
|
||||
"--psqldir=../../../$Config/psql",
|
||||
"--dbname=pl_regression","--load-language=$lang",@tests
|
||||
"--dbname=pl_regression",@lang_args,@tests
|
||||
);
|
||||
system(@args);
|
||||
my $status = $? >> 8;
|
||||
|
Loading…
x
Reference in New Issue
Block a user