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