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.

diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index a241cbce297a53ae2432825c9b00da911dbfe847..ae781b7e7647dda730a42ab7d7fc527b6f5fdd41 100644 (file)
--- 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 (file)
index 0000000..80824e0
--- /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 (file)
index 0000000..c464e56
--- /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 (file)
index 0000000..5b57a82
--- /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 (file)
index 0000000..978bb4b
--- /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 (file)
--- 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;