diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index a241cbce297a53ae2432825c9b00da911dbfe847..ae781b7e7647dda730a42ab7d7fc527b6f5fdd41 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 0000000000000000000000000000000000000000..80824e07ef1b25b5bd3ab26473b1103b00058c8e
--- /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 0000000000000000000000000000000000000000..c464e5625cebeca039962a67da8ff038e607dc44
--- /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 0000000000000000000000000000000000000000..5b57a8276ae02fa51f31fd54da25abf3240ddda1
--- /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 0000000000000000000000000000000000000000..978bb4bc15a262afc18a2168faf8e0b2ce0f2c20
--- /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 967238482f742bb7a5768f8bc9a4a694861086c0..1869588e92747935fab89c1bfe0cce767d861d3c 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;