Fix multiple causes of breakage in plperl's error handling.

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 299e389405fc4cdedda0fcf0100f656dfa0a320d..e4ad4102ac9b4d810d792afc040529f7a0364400 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *   ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *   $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.35 2002/09/21 18:39:26 tgl Exp $
+ *   $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.36 2003/04/20 21:15:34 tgl Exp $
  *
  **********************************************************************/
 
@@ -92,8 +92,6 @@ typedef struct plperl_proc_desc
  * Global data
  **********************************************************************/
 static int plperl_firstcall = 1;
-static int plperl_call_level = 0;
-static int plperl_restart_in_progress = 0;
 static PerlInterpreter *plperl_interp = NULL;
 static HV  *plperl_proc_hash = NULL;
 
@@ -143,6 +141,15 @@ plperl_init_all(void)
    if (!plperl_firstcall)
        return;
 
+   /************************************************************
+    * Free the proc hash table
+    ************************************************************/
+   if (plperl_proc_hash != NULL)
+   {
+       hv_undef(plperl_proc_hash);
+       SvREFCNT_dec((SV *) plperl_proc_hash);
+       plperl_proc_hash = NULL;
+   }
 
    /************************************************************
     * Destroy the existing Perl interpreter
@@ -154,16 +161,6 @@ plperl_init_all(void)
        plperl_interp = NULL;
    }
 
-   /************************************************************
-    * Free the proc hash table
-    ************************************************************/
-   if (plperl_proc_hash != NULL)
-   {
-       hv_undef(plperl_proc_hash);
-       SvREFCNT_dec((SV *) plperl_proc_hash);
-       plperl_proc_hash = NULL;
-   }
-
    /************************************************************
     * Now recreate a new Perl interpreter
     ************************************************************/
@@ -202,8 +199,6 @@ plperl_init_interp(void)
    perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL);
    perl_run(plperl_interp);
 
-
-
    /************************************************************
     * Initialize the proc and query hash tables
     ************************************************************/
@@ -212,7 +207,6 @@ plperl_init_interp(void)
 }
 
 
-
 /**********************************************************************
  * plperl_call_handler     - This is the only visible function
  *               of the PL interpreter. The PostgreSQL
@@ -229,7 +223,7 @@ plperl_call_handler(PG_FUNCTION_ARGS)
    Datum       retval;
 
    /************************************************************
-    * Initialize interpreters on first call
+    * Initialize interpreter on first call
     ************************************************************/
    if (plperl_firstcall)
        plperl_init_all();
@@ -239,10 +233,6 @@ plperl_call_handler(PG_FUNCTION_ARGS)
     ************************************************************/
    if (SPI_connect() != SPI_OK_CONNECT)
        elog(ERROR, "plperl: cannot connect to SPI manager");
-   /************************************************************
-    * Keep track about the nesting of Perl-SPI-Perl-... calls
-    ************************************************************/
-   plperl_call_level++;
 
    /************************************************************
     * Determine if called as function or trigger and
@@ -261,8 +251,6 @@ plperl_call_handler(PG_FUNCTION_ARGS)
    else
        retval = plperl_func_handler(fcinfo);
 
-   plperl_call_level--;
-
    return retval;
 }
 
@@ -272,13 +260,11 @@ plperl_call_handler(PG_FUNCTION_ARGS)
  *     create the anonymous subroutine whose text is in the SV.
  *     Returns the SV containing the RV to the closure.
  **********************************************************************/
-static
-SV *
+static SV *
 plperl_create_sub(char *s, bool trusted)
 {
    dSP;
-
-   SV         *subref = NULL;
+   SV         *subref;
    int         count;
 
    ENTER;
@@ -286,10 +272,23 @@ plperl_create_sub(char *s, bool trusted)
    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newSVpv(s, 0)));
    PUTBACK;
+   /*
+    * G_KEEPERR seems to be needed here, else we don't recognize compile
+    * errors properly.  Perhaps it's because there's another level of eval
+    * inside mksafefunc?
+    */
    count = perl_call_pv((trusted ? "mksafefunc" : "mkunsafefunc"),
                         G_SCALAR | G_EVAL | G_KEEPERR);
    SPAGAIN;
 
+   if (count != 1)
+   {
+       PUTBACK;
+       FREETMPS;
+       LEAVE;
+       elog(ERROR, "plperl: didn't get a return item from mksafefunc");
+   }
+
    if (SvTRUE(ERRSV))
    {
        POPs;
@@ -299,9 +298,6 @@ plperl_create_sub(char *s, bool trusted)
        elog(ERROR, "creation of function failed: %s", SvPV(ERRSV, PL_na));
    }
 
-   if (count != 1)
-       elog(ERROR, "creation of function failed - no return from mksafefunc");
-
    /*
     * need to make a deep copy of the return. it comes off the stack as a
     * temporary.
@@ -324,6 +320,7 @@ plperl_create_sub(char *s, bool trusted)
    PUTBACK;
    FREETMPS;
    LEAVE;
+
    return subref;
 }
 
@@ -352,21 +349,18 @@ plperl_init_shared_libs(pTHX)
  * plperl_call_perl_func()     - calls a perl function through the RV
  *         stored in the prodesc structure. massages the input parms properly
  **********************************************************************/
-static
-SV *
+static SV *
 plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
 {
    dSP;
-
    SV         *retval;
    int         i;
    int         count;
 
-
    ENTER;
    SAVETMPS;
 
-   PUSHMARK(sp);
+   PUSHMARK(SP);
    for (i = 0; i < desc->nargs; i++)
    {
        if (desc->arg_is_rel[i])
@@ -401,7 +395,9 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
        }
    }
    PUTBACK;
-   count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL | G_KEEPERR);
+
+   /* Do NOT use G_KEEPERR here */
+   count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
 
    SPAGAIN;
 
@@ -424,16 +420,14 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
 
    retval = newSVsv(POPs);
 
-
    PUTBACK;
    FREETMPS;
    LEAVE;
 
    return retval;
-
-
 }
 
+
 /**********************************************************************
  * plperl_func_handler()       - Handler for regular function calls
  **********************************************************************/
@@ -443,23 +437,10 @@ plperl_func_handler(PG_FUNCTION_ARGS)
    plperl_proc_desc *prodesc;
    SV         *perlret;
    Datum       retval;
-   sigjmp_buf  save_restart;
 
    /* Find or compile the function */
    prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
 
-   /* Set up error handling */
-   memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
-
-   if (sigsetjmp(Warn_restart, 1) != 0)
-   {
-       memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-       plperl_restart_in_progress = 1;
-       if (--plperl_call_level == 0)
-           plperl_restart_in_progress = 0;
-       siglongjmp(Warn_restart, 1);
-   }
-
    /************************************************************
     * Call the Perl function
     ************************************************************/
@@ -490,14 +471,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 
    SvREFCNT_dec(perlret);
 
-   memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-   if (plperl_restart_in_progress)
-   {
-       if (--plperl_call_level == 0)
-           plperl_restart_in_progress = 0;
-       siglongjmp(Warn_restart, 1);
-   }
-
    return retval;
 }
 
@@ -734,7 +707,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
  * plperl_build_tuple_argument() - Build a string for a ref to a hash
  *               from all attributes of a given tuple
  **********************************************************************/
-static SV  *
+static SV *
 plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 {
    int         i;