Add a regression test case based on bug #7516.

Given what we now know about the cause of this bug, it seems like it'd
be a real good idea to include it in the plperl regression tests, so as
to catch any platform-specific cases where the code gets misoptimized.

diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out
index 60eade8dddac8e5b9c7f674ad5be83195363d066..c447fa22cbc2cfcde3fa5fa5475e0e7bd8d5b947 100644 (file)
--- a/src/pl/plperl/expected/plperl_elog.out
+++ b/src/pl/plperl/expected/plperl_elog.out
@@ -62,3 +62,45 @@ select uses_global();
 do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
 NOTICE:  0
 CONTEXT:  PL/Perl anonymous code block
+-- test recovery after "die"
+create or replace function just_die() returns void language plperl AS $$
+die "just die";
+$$;
+select just_die();
+ERROR:  just die at line 2.
+CONTEXT:  PL/Perl function "just_die"
+create or replace function die_caller() returns int language plpgsql as $$
+BEGIN
+  BEGIN
+    PERFORM just_die();
+  EXCEPTION WHEN OTHERS THEN
+    RAISE NOTICE 'caught die';
+  END;
+  RETURN 1;
+END;
+$$;
+select die_caller();
+NOTICE:  caught die
+ die_caller 
+------------
+          1
+(1 row)
+
+create or replace function indirect_die_caller() returns int language plperl as $$
+my $prepared = spi_prepare('SELECT die_caller() AS fx');
+my $a = spi_exec_prepared($prepared)->{rows}->[0]->{fx};
+my $b = spi_exec_prepared($prepared)->{rows}->[0]->{fx};
+return $a + $b;
+$$;
+select indirect_die_caller();
+NOTICE:  caught die
+CONTEXT:  SQL statement "SELECT die_caller() AS fx"
+PL/Perl function "indirect_die_caller"
+NOTICE:  caught die
+CONTEXT:  SQL statement "SELECT die_caller() AS fx"
+PL/Perl function "indirect_die_caller"
+ indirect_die_caller 
+---------------------
+                   2
+(1 row)
+

diff --git a/src/pl/plperl/sql/plperl_elog.sql b/src/pl/plperl/sql/plperl_elog.sql
index 40896a48f482c840986e31df59596060ee51f0a2..032fd8b8ba74a570bafc1e00a7f91ddb697567be 100644 (file)
--- a/src/pl/plperl/sql/plperl_elog.sql
+++ b/src/pl/plperl/sql/plperl_elog.sql
@@ -46,3 +46,33 @@ select uses_global();
 
 -- make sure we don't choke on readonly values
 do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
+
+-- test recovery after "die"
+
+create or replace function just_die() returns void language plperl AS $$
+die "just die";
+$$;
+
+select just_die();
+
+create or replace function die_caller() returns int language plpgsql as $$
+BEGIN
+  BEGIN
+    PERFORM just_die();
+  EXCEPTION WHEN OTHERS THEN
+    RAISE NOTICE 'caught die';
+  END;
+  RETURN 1;
+END;
+$$;
+
+select die_caller();
+
+create or replace function indirect_die_caller() returns int language plperl as $$
+my $prepared = spi_prepare('SELECT die_caller() AS fx');
+my $a = spi_exec_prepared($prepared)->{rows}->[0]->{fx};
+my $b = spi_exec_prepared($prepared)->{rows}->[0]->{fx};
+return $a + $b;
+$$;
+
+select indirect_die_caller();