Skip to content
Snippets Groups Projects
Commit 510f3502 authored by Andrew Dunstan's avatar Andrew Dunstan
Browse files

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.
parent 0346442b
No related branches found
No related tags found
No related merge requests found
# Makefile for PL/Perl # 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 subdir = src/pl/plperl
top_builddir = ../../.. top_builddir = ../../..
...@@ -40,8 +40,15 @@ PERLCHUNKS = plc_perlboot.pl plc_safe_bad.pl plc_safe_ok.pl ...@@ -40,8 +40,15 @@ PERLCHUNKS = plc_perlboot.pl plc_safe_bad.pl plc_safe_ok.pl
SHLIB_LINK = $(perl_embed_ldflags) SHLIB_LINK = $(perl_embed_ldflags)
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
REGRESS = plperl plperl_trigger plperl_shared plperl_elog 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 # where to find psql for running the tests
PSQLDIR = $(bindir) PSQLDIR = $(bindir)
......
-- 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"
-- 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;
-- 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
-- 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;
# -*-perl-*- hey - emacs - this is a perl file # -*-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; use strict;
...@@ -151,14 +151,29 @@ sub plcheck ...@@ -151,14 +151,29 @@ sub plcheck
my $lang = $pl eq 'tcl' ? 'pltcl' : $pl; my $lang = $pl eq 'tcl' ? 'pltcl' : $pl;
next unless -d "../../$Config/$lang"; next unless -d "../../$Config/$lang";
$lang = 'plpythonu' if $lang eq 'plpython'; $lang = 'plpythonu' if $lang eq 'plpython';
my @lang_args = ( "--load-language=$lang" );
chdir $pl; 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 "============================================================\n";
print "Checking $lang\n"; print "Checking $lang\n";
my @tests = fetchTests();
my @args = ( my @args = (
"../../../$Config/pg_regress/pg_regress", "../../../$Config/pg_regress/pg_regress",
"--psqldir=../../../$Config/psql", "--psqldir=../../../$Config/psql",
"--dbname=pl_regression","--load-language=$lang",@tests "--dbname=pl_regression",@lang_args,@tests
); );
system(@args); system(@args);
my $status = $? >> 8; my $status = $? >> 8;
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment