aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/pl/plperl/expected/plperl.out2
-rw-r--r--src/pl/plperl/expected/plperl_elog.out2
-rw-r--r--src/pl/plperl/plperl.c30
-rw-r--r--src/pl/tcl/pltcl.c48
4 files changed, 50 insertions, 32 deletions
diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index d7914124104..e39d117424f 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 72adfa49bd6..fcb6e8d11e3 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 0c32bb4718e..b3df4dbc061 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 2970ffd740e..7f2cd543450 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);
}
generated by cgit v1.2.3 (git 2.25.1) at 2025-06-04 04:20:03 +0000