Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
Skip to content

Commit 9403598

Browse files
tglsfdctglsfdc
committed
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.
1 parent e77df38 commit 9403598

File tree

4 files changed

+50
-32
lines changed

4 files changed

+50
-32
lines changed

‎src/pl/plperl/expected/plperl.out

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -496,4 +496,4 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS doubl
496496
return $result;
497497
$$ LANGUAGE plperl;
498498
SELECT perl_spi_prepared_bad(4.35) as "double precision";
499-
ERROR: error from Perl function: type "does_not_exist" does not exist at line 2.
499+
ERROR: error from Perl function "perl_spi_prepared_bad": type "does_not_exist" does not exist at line 2.

‎src/pl/plperl/expected/plperl_elog.out

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ create or replace function uses_global() returns text language plperl as $$
3535
return 'uses_global worked';
3636

3737
$$;
38-
ERROR: creation of Perl function failed: Global symbol "$global" requires explicit package name at line 3.
38+
ERROR: creation of Perl function "uses_global" failed: Global symbol "$global" requires explicit package name at line 3.
3939
Global symbol "$other_global" requires explicit package name at line 4.
4040
select uses_global();
4141
ERROR: function uses_global() does not exist

‎src/pl/plperl/plperl.c

Lines changed: 18 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
/**********************************************************************
22
* plperl.c - perl as a procedural language for PostgreSQL
33
*
4-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.129 2007/06/28 17:49:59 tgl Exp $
4+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.130 2007/10/05 17:06:11 tgl Exp $
55
*
66
**********************************************************************/
77

@@ -39,7 +39,7 @@ PG_MODULE_MAGIC;
3939
**********************************************************************/
4040
typedef struct plperl_proc_desc
4141
{
42-
char *proname;
42+
char *proname; /* user name of procedure */
4343
TransactionId fn_xmin;
4444
ItemPointerData fn_tid;
4545
bool fn_readonly;
@@ -60,7 +60,7 @@ typedef struct plperl_proc_desc
6060

6161
typedef struct plperl_proc_entry
6262
{
63-
char proc_name[NAMEDATALEN];
63+
char proc_name[NAMEDATALEN]; /* internal name, eg __PLPerl_proc_39987 */
6464
plperl_proc_desc *proc_data;
6565
} plperl_proc_entry;
6666

@@ -887,7 +887,7 @@ plperl_validator(PG_FUNCTION_ARGS)
887887
* supplied in s, and returns a reference to the closure.
888888
*/
889889
static SV *
890-
plperl_create_sub(char *s, bool trusted)
890+
plperl_create_sub(char *proname, char *s, bool trusted)
891891
{
892892
dSP;
893893
SV *subref;
@@ -941,7 +941,8 @@ plperl_create_sub(char *s, bool trusted)
941941
LEAVE;
942942
ereport(ERROR,
943943
(errcode(ERRCODE_SYNTAX_ERROR),
944-
errmsg("creation of Perl function failed: %s",
944+
errmsg("creation of Perl function \"%s\" failed: %s",
945+
proname,
945946
strip_trailing_ws(SvPV(ERRSV, PL_na)))));
946947
}
947948

@@ -1070,7 +1071,8 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
10701071
LEAVE;
10711072
/* XXX need to find a way to assign an errcode here */
10721073
ereport(ERROR,
1073-
(errmsg("error from Perl function: %s",
1074+
(errmsg("error from Perl function \"%s\": %s",
1075+
desc->proname,
10741076
strip_trailing_ws(SvPV(ERRSV, PL_na)))));
10751077
}
10761078

@@ -1127,7 +1129,8 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
11271129
LEAVE;
11281130
/* XXX need to find a way to assign an errcode here */
11291131
ereport(ERROR,
1130-
(errmsg("error from Perl trigger function: %s",
1132+
(errmsg("error from Perl function \"%s\": %s",
1133+
desc->proname,
11311134
strip_trailing_ws(SvPV(ERRSV, PL_na)))));
11321135
}
11331136

@@ -1403,7 +1406,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
14031406
{
14041407
HeapTuple procTup;
14051408
Form_pg_proc procStruct;
1406-
char internal_proname[64];
1409+
char internal_proname[NAMEDATALEN];
14071410
plperl_proc_desc *prodesc = NULL;
14081411
int i;
14091412
plperl_proc_entry *hash_entry;
@@ -1448,10 +1451,11 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
14481451

14491452
if (!uptodate)
14501453
{
1451-
free(prodesc); /* are we leaking memory here? */
1454+
free(prodesc->proname);
1455+
free(prodesc);
14521456
prodesc = NULL;
14531457
hash_search(plperl_proc_hash, internal_proname,
1454-
HASH_REMOVE,NULL);
1458+
HASH_REMOVE, NULL);
14551459
}
14561460
}
14571461

@@ -1482,7 +1486,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
14821486
(errcode(ERRCODE_OUT_OF_MEMORY),
14831487
errmsg("out of memory")));
14841488
MemSet(prodesc, 0, sizeof(plperl_proc_desc));
1485-
prodesc->proname = strdup(internal_proname);
1489+
prodesc->proname = strdup(NameStr(procStruct->proname));
14861490
prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
14871491
prodesc->fn_tid = procTup->t_self;
14881492

@@ -1628,7 +1632,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
16281632

16291633
check_interp(prodesc->lanpltrusted);
16301634

1631-
prodesc->reference = plperl_create_sub(proc_source, prodesc->lanpltrusted);
1635+
prodesc->reference = plperl_create_sub(prodesc->proname,
1636+
proc_source,
1637+
prodesc->lanpltrusted);
16321638

16331639
restore_context(oldcontext);
16341640

‎src/pl/tcl/pltcl.c

Lines changed: 30 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
* pltcl.c - PostgreSQL support for Tcl as
33
* procedural language (PL)
44
*
5-
* $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.114 2007/09/28 22:33:20 momjian Exp $
5+
* $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.115 2007/10/05 17:06:11 tgl Exp $
66
*
77
**********************************************************************/
88

@@ -76,7 +76,8 @@ PG_MODULE_MAGIC;
7676
**********************************************************************/
7777
typedef struct pltcl_proc_desc
7878
{
79-
char *proname;
79+
char *user_proname;
80+
char *internal_proname;
8081
TransactionId fn_xmin;
8182
ItemPointerData fn_tid;
8283
bool fn_readonly;
@@ -549,7 +550,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
549550
************************************************************/
550551
Tcl_DStringInit(&tcl_cmd);
551552
Tcl_DStringInit(&list_tmp);
552-
Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);
553+
Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
553554

554555
/************************************************************
555556
* Add all call arguments to the command
@@ -636,9 +637,10 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
636637
UTF_BEGIN;
637638
ereport(ERROR,
638639
(errmsg("%s", interp->result),
639-
errcontext("%s",
640+
errcontext("%s\nin PL/Tcl function \"%s\"",
640641
UTF_U2E(Tcl_GetVar(interp, "errorInfo",
641-
TCL_GLOBAL_ONLY)))));
642+
TCL_GLOBAL_ONLY)),
643+
prodesc->user_proname)));
642644
UTF_END;
643645
}
644646

@@ -723,7 +725,7 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
723725
PG_TRY();
724726
{
725727
/* The procedure name */
726-
Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);
728+
Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
727729

728730
/* The trigger name for argument TG_name */
729731
Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
@@ -865,9 +867,10 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
865867
UTF_BEGIN;
866868
ereport(ERROR,
867869
(errmsg("%s", interp->result),
868-
errcontext("%s",
870+
errcontext("%s\nin PL/Tcl function \"%s\"",
869871
UTF_U2E(Tcl_GetVar(interp, "errorInfo",
870-
TCL_GLOBAL_ONLY)))));
872+
TCL_GLOBAL_ONLY)),
873+
prodesc->user_proname)));
871874
UTF_END;
872875
}
873876

@@ -1085,7 +1088,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
10851088
(errcode(ERRCODE_OUT_OF_MEMORY),
10861089
errmsg("out of memory")));
10871090
MemSet(prodesc, 0, sizeof(pltcl_proc_desc));
1088-
prodesc->proname = strdup(internal_proname);
1091+
prodesc->user_proname = strdup(NameStr(procStruct->proname));
1092+
prodesc->internal_proname = strdup(internal_proname);
10891093
prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
10901094
prodesc->fn_tid = procTup->t_self;
10911095

@@ -1101,7 +1105,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
11011105
0, 0, 0);
11021106
if (!HeapTupleIsValid(langTup))
11031107
{
1104-
free(prodesc->proname);
1108+
free(prodesc->user_proname);
1109+
free(prodesc->internal_proname);
11051110
free(prodesc);
11061111
elog(ERROR, "cache lookup failed for language %u",
11071112
procStruct->prolang);
@@ -1126,7 +1131,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
11261131
0, 0, 0);
11271132
if (!HeapTupleIsValid(typeTup))
11281133
{
1129-
free(prodesc->proname);
1134+
free(prodesc->user_proname);
1135+
free(prodesc->internal_proname);
11301136
free(prodesc);
11311137
elog(ERROR, "cache lookup failed for type %u",
11321138
procStruct->prorettype);
@@ -1140,15 +1146,17 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
11401146
/* okay */ ;
11411147
else if (procStruct->prorettype == TRIGGEROID)
11421148
{
1143-
free(prodesc->proname);
1149+
free(prodesc->user_proname);
1150+
free(prodesc->internal_proname);
11441151
free(prodesc);
11451152
ereport(ERROR,
11461153
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
11471154
errmsg("trigger functions can only be called as triggers")));
11481155
}
11491156
else
11501157
{
1151-
free(prodesc->proname);
1158+
free(prodesc->user_proname);
1159+
free(prodesc->internal_proname);
11521160
free(prodesc);
11531161
ereport(ERROR,
11541162
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
@@ -1159,7 +1167,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
11591167

11601168
if (typeStruct->typtype == TYPTYPE_COMPOSITE)
11611169
{
1162-
free(prodesc->proname);
1170+
free(prodesc->user_proname);
1171+
free(prodesc->internal_proname);
11631172
free(prodesc);
11641173
ereport(ERROR,
11651174
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
@@ -1187,7 +1196,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
11871196
0, 0, 0);
11881197
if (!HeapTupleIsValid(typeTup))
11891198
{
1190-
free(prodesc->proname);
1199+
free(prodesc->user_proname);
1200+
free(prodesc->internal_proname);
11911201
free(prodesc);
11921202
elog(ERROR, "cache lookup failed for type %u",
11931203
procStruct->proargtypes.values[i]);
@@ -1197,7 +1207,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
11971207
/* Disallow pseudotype argument */
11981208
if (typeStruct->typtype == TYPTYPE_PSEUDO)
11991209
{
1200-
free(prodesc->proname);
1210+
free(prodesc->user_proname);
1211+
free(prodesc->internal_proname);
12011212
free(prodesc);
12021213
ereport(ERROR,
12031214
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
@@ -1305,7 +1316,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
13051316
Tcl_DStringFree(&proc_internal_def);
13061317
if (tcl_rc != TCL_OK)
13071318
{
1308-
free(prodesc->proname);
1319+
free(prodesc->user_proname);
1320+
free(prodesc->internal_proname);
13091321
free(prodesc);
13101322
elog(ERROR, "could not create internal procedure \"%s\": %s",
13111323
internal_proname, interp->result);
@@ -1315,7 +1327,7 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
13151327
* Add the proc description block to the hashtable
13161328
************************************************************/
13171329
hashent = Tcl_CreateHashEntry(pltcl_proc_hash,
1318-
prodesc->proname, &hashnew);
1330+
prodesc->internal_proname, &hashnew);
13191331
Tcl_SetHashValue(hashent, (ClientData) prodesc);
13201332
}
13211333

0 commit comments

Comments
 (0)