From 94035980596cb709ffb637aadcee0a87a7c17d78 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Fri, 5 Oct 2007 17:06:11 +0000 Subject: [PATCH] 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. --- src/pl/plperl/expected/plperl.out | 2 +- src/pl/plperl/expected/plperl_elog.out | 2 +- src/pl/plperl/plperl.c | 30 +++++++++------- src/pl/tcl/pltcl.c | 48 ++++++++++++++++---------- 4 files changed, 50 insertions(+), 32 deletions(-) diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index d791412410..e39d117424 100644 --- 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 72adfa49bd..fcb6e8d11e 100644 --- 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 0c32bb4718..b3df4dbc06 100644 --- 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 2970ffd740..7f2cd54345 100644 --- 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); } -- 2.39.5