Fix plperl and pltcl to include the name of the current function when

passing on errors from the language interpreter.  (plpython seems
fairly OK about this already.)  Per gripe from Robert Kleemann.

diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index d7914124104de912a32627b74e1aed0d90271cc7..e39d117424fdf792de3d4087ae9f5bb0a02643ec 100644 (file)
--- a/src/pl/plperl/expected/plperl.out
+++ b/src/pl/plperl/expected/plperl.out
@@ -496,4 +496,4 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS doubl
   return $result;
 $$ LANGUAGE plperl;
 SELECT perl_spi_prepared_bad(4.35) as "double precision";
-ERROR:  error from Perl function: type "does_not_exist" does not exist at line 2.
+ERROR:  error from Perl function "perl_spi_prepared_bad": type "does_not_exist" does not exist at line 2.

diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out
index 72adfa49bd6ebfa3549ce38f1ed688da782fe97f..fcb6e8d11e36b2464a0d4d83f891933602760b46 100644 (file)
--- a/src/pl/plperl/expected/plperl_elog.out
+++ b/src/pl/plperl/expected/plperl_elog.out
@@ -35,7 +35,7 @@ create or replace function uses_global() returns text language plperl as $$
   return 'uses_global worked';
 
 $$;
-ERROR:  creation of Perl function failed: Global symbol "$global" requires explicit package name at line 3.
+ERROR:  creation of Perl function "uses_global" failed: Global symbol "$global" requires explicit package name at line 3.
 Global symbol "$other_global" requires explicit package name at line 4.
 select uses_global();
 ERROR:  function uses_global() does not exist

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 0c32bb4718ee02344d4644fb6393a51b70e3f602..b3df4dbc061f830a1f5647c777f20105191727f7 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1,7 +1,7 @@
 /**********************************************************************
  * plperl.c - perl as a procedural language for PostgreSQL
  *
- *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.129 2007/06/28 17:49:59 tgl Exp $
+ *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.130 2007/10/05 17:06:11 tgl Exp $
  *
  **********************************************************************/
 
@@ -39,7 +39,7 @@ PG_MODULE_MAGIC;
  **********************************************************************/
 typedef struct plperl_proc_desc
 {
-       char       *proname;
+       char       *proname;            /* user name of procedure */
        TransactionId fn_xmin;
        ItemPointerData fn_tid;
        bool            fn_readonly;
@@ -60,7 +60,7 @@ typedef struct plperl_proc_desc
 
 typedef struct plperl_proc_entry
 {
-       char proc_name[NAMEDATALEN];
+       char proc_name[NAMEDATALEN]; /* internal name, eg __PLPerl_proc_39987 */
        plperl_proc_desc *proc_data;
 } plperl_proc_entry;
 
@@ -887,7 +887,7 @@ plperl_validator(PG_FUNCTION_ARGS)
  * supplied in s, and returns a reference to the closure.
  */
 static SV  *
-plperl_create_sub(char *s, bool trusted)
+plperl_create_sub(char *proname, char *s, bool trusted)
 {
        dSP;
        SV                 *subref;
@@ -941,7 +941,8 @@ plperl_create_sub(char *s, bool trusted)
                LEAVE;
                ereport(ERROR,
                                (errcode(ERRCODE_SYNTAX_ERROR),
-                                errmsg("creation of Perl function failed: %s",
+                                errmsg("creation of Perl function \"%s\" failed: %s",
+                                               proname,
                                                strip_trailing_ws(SvPV(ERRSV, PL_na)))));
        }
 
@@ -1070,7 +1071,8 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
                LEAVE;
                /* XXX need to find a way to assign an errcode here */
                ereport(ERROR,
-                               (errmsg("error from Perl function: %s",
+                               (errmsg("error from Perl function \"%s\": %s",
+                                               desc->proname,
                                                strip_trailing_ws(SvPV(ERRSV, PL_na)))));
        }
 
@@ -1127,7 +1129,8 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
                LEAVE;
                /* XXX need to find a way to assign an errcode here */
                ereport(ERROR,
-                               (errmsg("error from Perl trigger function: %s",
+                               (errmsg("error from Perl function \"%s\": %s",
+                                               desc->proname,
                                                strip_trailing_ws(SvPV(ERRSV, PL_na)))));
        }
 
@@ -1403,7 +1406,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
 {
        HeapTuple       procTup;
        Form_pg_proc procStruct;
-       char            internal_proname[64];
+       char            internal_proname[NAMEDATALEN];
        plperl_proc_desc *prodesc = NULL;
        int                     i;
        plperl_proc_entry *hash_entry;
@@ -1448,10 +1451,11 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
 
                if (!uptodate)
                {
-                       free(prodesc); /* are we leaking memory here? */
+                       free(prodesc->proname);
+                       free(prodesc);
                        prodesc = NULL;
                        hash_search(plperl_proc_hash, internal_proname,
-                                               HASH_REMOVE,NULL);
+                                               HASH_REMOVE, NULL);
                }
        }
 
@@ -1482,7 +1486,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
                                        (errcode(ERRCODE_OUT_OF_MEMORY),
                                         errmsg("out of memory")));
                MemSet(prodesc, 0, sizeof(plperl_proc_desc));
-               prodesc->proname = strdup(internal_proname);
+               prodesc->proname = strdup(NameStr(procStruct->proname));
                prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
                prodesc->fn_tid = procTup->t_self;
 
@@ -1628,7 +1632,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
 
                check_interp(prodesc->lanpltrusted);
 
-               prodesc->reference = plperl_create_sub(proc_source, prodesc->lanpltrusted);
+               prodesc->reference = plperl_create_sub(prodesc->proname,
+                                                                                          proc_source,
+                                                                                          prodesc->lanpltrusted);
 
                restore_context(oldcontext);
 

diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 2970ffd740ea9f254862b378817384ba52fed157..7f2cd5434502a5517d58d8ea311b8ccd8b99d7e1 100644 (file)
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -2,7 +2,7 @@
  * pltcl.c             - PostgreSQL support for Tcl as
  *                               procedural language (PL)
  *
- *       $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.114 2007/09/28 22:33:20 momjian Exp $
+ *       $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.115 2007/10/05 17:06:11 tgl Exp $
  *
  **********************************************************************/
 
@@ -76,7 +76,8 @@ PG_MODULE_MAGIC;
  **********************************************************************/
 typedef struct pltcl_proc_desc
 {
-       char       *proname;
+       char       *user_proname;
+       char       *internal_proname;
        TransactionId fn_xmin;
        ItemPointerData fn_tid;
        bool            fn_readonly;
@@ -549,7 +550,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
         ************************************************************/
        Tcl_DStringInit(&tcl_cmd);
        Tcl_DStringInit(&list_tmp);
-       Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);
+       Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
 
        /************************************************************
         * Add all call arguments to the command
@@ -636,9 +637,10 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
                UTF_BEGIN;
                ereport(ERROR,
                                (errmsg("%s", interp->result),
-                                errcontext("%s",
+                                errcontext("%s\nin PL/Tcl function \"%s\"",
                                                        UTF_U2E(Tcl_GetVar(interp, "errorInfo",
-                                                                                          TCL_GLOBAL_ONLY)))));
+                                                                                          TCL_GLOBAL_ONLY)),
+                                                       prodesc->user_proname)));
                UTF_END;
        }
 
@@ -723,7 +725,7 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
        PG_TRY();
        {
                /* The procedure name */
-               Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);
+               Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
 
                /* The trigger name for argument TG_name */
                Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
@@ -865,9 +867,10 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
                UTF_BEGIN;
                ereport(ERROR,
                                (errmsg("%s", interp->result),
-                                errcontext("%s",
+                                errcontext("%s\nin PL/Tcl function \"%s\"",
                                                        UTF_U2E(Tcl_GetVar(interp, "errorInfo",
-                                                                                          TCL_GLOBAL_ONLY)))));
+                                                                                          TCL_GLOBAL_ONLY)),
+                                                       prodesc->user_proname)));
                UTF_END;
        }
 
@@ -1085,7 +1088,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                                        (errcode(ERRCODE_OUT_OF_MEMORY),
                                         errmsg("out of memory")));
                MemSet(prodesc, 0, sizeof(pltcl_proc_desc));
-               prodesc->proname = strdup(internal_proname);
+               prodesc->user_proname = strdup(NameStr(procStruct->proname));
+               prodesc->internal_proname = strdup(internal_proname);
                prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
                prodesc->fn_tid = procTup->t_self;
 
@@ -1101,7 +1105,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                                                                 0, 0, 0);
                if (!HeapTupleIsValid(langTup))
                {
-                       free(prodesc->proname);
+                       free(prodesc->user_proname);
+                       free(prodesc->internal_proname);
                        free(prodesc);
                        elog(ERROR, "cache lookup failed for language %u",
                                 procStruct->prolang);
@@ -1126,7 +1131,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                                                                         0, 0, 0);
                        if (!HeapTupleIsValid(typeTup))
                        {
-                               free(prodesc->proname);
+                               free(prodesc->user_proname);
+                               free(prodesc->internal_proname);
                                free(prodesc);
                                elog(ERROR, "cache lookup failed for type %u",
                                         procStruct->prorettype);
@@ -1140,7 +1146,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                                         /* okay */ ;
                                else if (procStruct->prorettype == TRIGGEROID)
                                {
-                                       free(prodesc->proname);
+                                       free(prodesc->user_proname);
+                                       free(prodesc->internal_proname);
                                        free(prodesc);
                                        ereport(ERROR,
                                                        (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
@@ -1148,7 +1155,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                                }
                                else
                                {
-                                       free(prodesc->proname);
+                                       free(prodesc->user_proname);
+                                       free(prodesc->internal_proname);
                                        free(prodesc);
                                        ereport(ERROR,
                                                        (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
@@ -1159,7 +1167,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
 
                        if (typeStruct->typtype == TYPTYPE_COMPOSITE)
                        {
-                               free(prodesc->proname);
+                               free(prodesc->user_proname);
+                               free(prodesc->internal_proname);
                                free(prodesc);
                                ereport(ERROR,
                                                (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
@@ -1187,7 +1196,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                                                                                 0, 0, 0);
                                if (!HeapTupleIsValid(typeTup))
                                {
-                                       free(prodesc->proname);
+                                       free(prodesc->user_proname);
+                                       free(prodesc->internal_proname);
                                        free(prodesc);
                                        elog(ERROR, "cache lookup failed for type %u",
                                                 procStruct->proargtypes.values[i]);
@@ -1197,7 +1207,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                                /* Disallow pseudotype argument */
                                if (typeStruct->typtype == TYPTYPE_PSEUDO)
                                {
-                                       free(prodesc->proname);
+                                       free(prodesc->user_proname);
+                                       free(prodesc->internal_proname);
                                        free(prodesc);
                                        ereport(ERROR,
                                                        (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
@@ -1305,7 +1316,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                Tcl_DStringFree(&proc_internal_def);
                if (tcl_rc != TCL_OK)
                {
-                       free(prodesc->proname);
+                       free(prodesc->user_proname);
+                       free(prodesc->internal_proname);
                        free(prodesc);
                        elog(ERROR, "could not create internal procedure \"%s\": %s",
                                 internal_proname, interp->result);
@@ -1315,7 +1327,7 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
                 * Add the proc description block to the hashtable
                 ************************************************************/
                hashent = Tcl_CreateHashEntry(pltcl_proc_hash,
-                                                                         prodesc->proname, &hashnew);
+                                                                         prodesc->internal_proname, &hashnew);
                Tcl_SetHashValue(hashent, (ClientData) prodesc);
        }