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:
Andrew Dunstan 2010-01-09 15:25:41 +00:00
parent 0346442b5d
commit 510f3502eb
6 changed files with 82 additions and 6 deletions

View File

@ -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)

View 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"

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

View 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

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

View File

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