From b8fbbcf37f22c5e8361da939ad0fc4be18a34ca9 Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Fri, 14 Sep 2012 11:05:53 -0400
Subject: [PATCH] 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.
---
 src/pl/plperl/expected/plperl_elog.out | 42 ++++++++++++++++++++++++++
 src/pl/plperl/sql/plperl_elog.sql      | 30 ++++++++++++++++++
 2 files changed, 72 insertions(+)

diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out
index 60eade8ddd..c447fa22cb 100644
--- 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 40896a48f4..032fd8b8ba 100644
--- 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();