Back-patch fix and test case for bug #7516.

Back-patch commits 9afc6481117d2dd936e752da0424a2b6b05f6459 and
b8fbbcf37f22c5e8361da939ad0fc4be18a34ca9.  The first of these is really
a minor code cleanup to save a few cycles, but it turns out to provide
a workaround for the misoptimization problem described in bug #7516.
The second commit adds a regression test case.

Back-patch the fix to all active branches.  The test case only works
as far back as 9.0, because it relies on plpgsql which isn't installed
by default before that.  (I didn't have success modifying it into an
all-plperl form that still provoked a crash, though this may just reflect
my lack of Perl-fu.)

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/plperl.c b/src/pl/plperl/plperl.c
index 4754f5988c9c70822d2f6b6ea0242fd64e588a99..b8c75c26e12113b2fa7c50875462530eb9e15bb4 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1696,10 +1696,15 @@ plperl_call_handler(PG_FUNCTION_ARGS)
    Datum       retval;
    plperl_call_data *save_call_data = current_call_data;
    plperl_interp_desc *oldinterp = plperl_active_interp;
+   plperl_call_data this_call_data;
+
+   /* Initialize current-call status record */
+   MemSet(&this_call_data, 0, sizeof(this_call_data));
+   this_call_data.fcinfo = fcinfo;
 
    PG_TRY();
    {
-       current_call_data = NULL;
+       current_call_data = &this_call_data;
        if (CALLED_AS_TRIGGER(fcinfo))
            retval = PointerGetDatum(plperl_trigger_handler(fcinfo));
        else
@@ -1707,16 +1712,16 @@ plperl_call_handler(PG_FUNCTION_ARGS)
    }
    PG_CATCH();
    {
-       if (current_call_data && current_call_data->prodesc)
-           decrement_prodesc_refcount(current_call_data->prodesc);
+       if (this_call_data.prodesc)
+           decrement_prodesc_refcount(this_call_data.prodesc);
        current_call_data = save_call_data;
        activate_interpreter(oldinterp);
        PG_RE_THROW();
    }
    PG_END_TRY();
 
-   if (current_call_data && current_call_data->prodesc)
-       decrement_prodesc_refcount(current_call_data->prodesc);
+   if (this_call_data.prodesc)
+       decrement_prodesc_refcount(this_call_data.prodesc);
    current_call_data = save_call_data;
    activate_interpreter(oldinterp);
    return retval;
@@ -1736,8 +1741,12 @@ plperl_inline_handler(PG_FUNCTION_ARGS)
    plperl_proc_desc desc;
    plperl_call_data *save_call_data = current_call_data;
    plperl_interp_desc *oldinterp = plperl_active_interp;
+   plperl_call_data this_call_data;
    ErrorContextCallback pl_error_context;
 
+   /* Initialize current-call status record */
+   MemSet(&this_call_data, 0, sizeof(this_call_data));
+
    /* Set up a callback for error reporting */
    pl_error_context.callback = plperl_inline_callback;
    pl_error_context.previous = error_context_stack;
@@ -1768,14 +1777,15 @@ plperl_inline_handler(PG_FUNCTION_ARGS)
    desc.nargs = 0;
    desc.reference = NULL;
 
+   this_call_data.fcinfo = &fake_fcinfo;
+   this_call_data.prodesc = &desc;
+   /* we do not bother with refcounting the fake prodesc */
+
    PG_TRY();
    {
        SV         *perlret;
 
-       current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
-       current_call_data->fcinfo = &fake_fcinfo;
-       current_call_data->prodesc = &desc;
-       /* we do not bother with refcounting the fake prodesc */
+       current_call_data = &this_call_data;
 
        if (SPI_connect() != SPI_OK_CONNECT)
            elog(ERROR, "could not connect to SPI manager");
@@ -2158,13 +2168,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
    ReturnSetInfo *rsi;
    ErrorContextCallback pl_error_context;
 
-   /*
-    * Create the call_data before connecting to SPI, so that it is not
-    * allocated in the SPI memory context
-    */
-   current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
-   current_call_data->fcinfo = fcinfo;
-
    if (SPI_connect() != SPI_OK_CONNECT)
        elog(ERROR, "could not connect to SPI manager");
 
@@ -2277,13 +2280,6 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
    HV         *hvTD;
    ErrorContextCallback pl_error_context;
 
-   /*
-    * Create the call_data before connecting to SPI, so that it is not
-    * allocated in the SPI memory context
-    */
-   current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
-   current_call_data->fcinfo = fcinfo;
-
    /* Connect to SPI manager */
    if (SPI_connect() != SPI_OK_CONNECT)
        elog(ERROR, "could not connect to SPI manager");

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();