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 **********************************************************************/
7777typedef 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