diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile index a241cbce29..ae781b7e76 100644 --- a/src/pl/plperl/GNUmakefile +++ b/src/pl/plperl/GNUmakefile @@ -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) diff --git a/src/pl/plperl/expected/plperl_plperlu.out b/src/pl/plperl/expected/plperl_plperlu.out new file mode 100644 index 0000000000..80824e07ef --- /dev/null +++ b/src/pl/plperl/expected/plperl_plperlu.out @@ -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" diff --git a/src/pl/plperl/expected/plperlu.out b/src/pl/plperl/expected/plperlu.out new file mode 100644 index 0000000000..c464e5625c --- /dev/null +++ b/src/pl/plperl/expected/plperlu.out @@ -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; diff --git a/src/pl/plperl/sql/plperl_plperlu.sql b/src/pl/plperl/sql/plperl_plperlu.sql new file mode 100644 index 0000000000..5b57a8276a --- /dev/null +++ b/src/pl/plperl/sql/plperl_plperlu.sql @@ -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 + + diff --git a/src/pl/plperl/sql/plperlu.sql b/src/pl/plperl/sql/plperlu.sql new file mode 100644 index 0000000000..978bb4bc15 --- /dev/null +++ b/src/pl/plperl/sql/plperlu.sql @@ -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; diff --git a/src/tools/msvc/vcregress.pl b/src/tools/msvc/vcregress.pl index 967238482f..1869588e92 100644 --- a/src/tools/msvc/vcregress.pl +++ b/src/tools/msvc/vcregress.pl @@ -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;