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 60eade8ddda..c447fa22cbc 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 40896a48f48..032fd8b8ba7 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();
--
GitLab