NotificationsYou must be signed in to change notification settings
Fork5
Star26

Commite3f0271

committed

errcontext support in PL/Perl

Author: Alexey Klyukin <alexk@commandprompt.com>

1 parent384cad5 commite3f0271Copy full SHA for e3f0271

File tree

4 files changed

+112

-12

lines changed

src/pl/plperl
- expected
- plperl.c

4 files changed

+112

-12

lines changed

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

Lines changed: 16 additions & 1 deletion

Original file line number	Diff line number	Diff line change
`@@ -122,8 +122,10 @@ CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$`
`122`	`122`	`$$ LANGUAGE plperl;`
`123`	`123`	`SELECT perl_set();`
`124`	`124`	`ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash`
	`125`	`+CONTEXT: PL/Perl function "perl_set"`
`125`	`126`	`SELECT * FROM perl_set();`
`126`	`127`	`ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash`
	`128`	`+CONTEXT: PL/Perl function "perl_set"`
`127`	`129`	`CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$`
`128`	`130`	`return [`
`129`	`131`	`{ f1 => 1, f2 => 'Hello', f3 => 'World' },`
`@@ -171,6 +173,7 @@ CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$`
`171`	`173`	`$$ LANGUAGE plperl;`
`172`	`174`	`SELECT perl_record();`
`173`	`175`	`ERROR: function returning record called in context that cannot accept type record`
	`176`	`+CONTEXT: PL/Perl function "perl_record"`
`174`	`177`	`SELECT * FROM perl_record();`
`175`	`178`	`ERROR: a column definition list is required for functions returning "record"`
`176`	`179`	`LINE 1: SELECT * FROM perl_record();`
`@@ -186,6 +189,7 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$`
`186`	`189`	`$$ LANGUAGE plperl;`
`187`	`190`	`SELECT perl_record_set();`
`188`	`191`	`ERROR: set-valued function called in context that cannot accept a set`
	`192`	`+CONTEXT: PL/Perl function "perl_record_set"`
`189`	`193`	`SELECT * FROM perl_record_set();`
`190`	`194`	`ERROR: a column definition list is required for functions returning "record"`
`191`	`195`	`LINE 1: SELECT * FROM perl_record_set();`
`@@ -204,12 +208,14 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$`
`204`	`208`	`$$ LANGUAGE plperl;`
`205`	`209`	`SELECT perl_record_set();`
`206`	`210`	`ERROR: set-valued function called in context that cannot accept a set`
	`211`	`+CONTEXT: PL/Perl function "perl_record_set"`
`207`	`212`	`SELECT * FROM perl_record_set();`
`208`	`213`	`ERROR: a column definition list is required for functions returning "record"`
`209`	`214`	`LINE 1: SELECT * FROM perl_record_set();`
`210`	`215`	`^`
`211`	`216`	`SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);`
`212`	`217`	`ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash`
	`218`	`+CONTEXT: PL/Perl function "perl_record_set"`
`213`	`219`	`CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$`
`214`	`220`	`return [`
`215`	`221`	`{ f1 => 1, f2 => 'Hello', f3 => 'World' },`
`@@ -219,6 +225,7 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$`
`219`	`225`	`$$ LANGUAGE plperl;`
`220`	`226`	`SELECT perl_record_set();`
`221`	`227`	`ERROR: set-valued function called in context that cannot accept a set`
	`228`	`+CONTEXT: PL/Perl function "perl_record_set"`
`222`	`229`	`SELECT * FROM perl_record_set();`
`223`	`230`	`ERROR: a column definition list is required for functions returning "record"`
`224`	`231`	`LINE 1: SELECT * FROM perl_record_set();`
`@@ -308,11 +315,13 @@ CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$`
`308`	`315`	`$$ LANGUAGE plperl;`
`309`	`316`	`SELECT * FROM foo_bad();`
`310`	`317`	`ERROR: Perl hash contains nonexistent column "z"`
	`318`	`+CONTEXT: PL/Perl function "foo_bad"`
`311`	`319`	`CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$`
`312`	`320`	`return 42;`
`313`	`321`	`$$ LANGUAGE plperl;`
`314`	`322`	`SELECT * FROM foo_bad();`
`315`	`323`	`ERROR: composite-returning PL/Perl function must return reference to hash`
	`324`	`+CONTEXT: PL/Perl function "foo_bad"`
`316`	`325`	`CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$`
`317`	`326`	`return [`
`318`	`327`	`[1, 2],`
`@@ -321,16 +330,19 @@ return [`
`321`	`330`	`$$ LANGUAGE plperl;`
`322`	`331`	`SELECT * FROM foo_bad();`
`323`	`332`	`ERROR: composite-returning PL/Perl function must return reference to hash`
	`333`	`+CONTEXT: PL/Perl function "foo_bad"`
`324`	`334`	`CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$`
`325`	`335`	`return 42;`
`326`	`336`	`$$ LANGUAGE plperl;`
`327`	`337`	`SELECT * FROM foo_set_bad();`
`328`	`338`	`ERROR: set-returning PL/Perl function must return reference to array or use return_next`
	`339`	`+CONTEXT: PL/Perl function "foo_set_bad"`
`329`	`340`	`CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$`
`330`	`341`	`return {y => 3, z => 4};`
`331`	`342`	`$$ LANGUAGE plperl;`
`332`	`343`	`SELECT * FROM foo_set_bad();`
`333`	`344`	`ERROR: set-returning PL/Perl function must return reference to array or use return_next`
	`345`	`+CONTEXT: PL/Perl function "foo_set_bad"`
`334`	`346`	`CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$`
`335`	`347`	`return [`
`336`	`348`	`[1, 2],`
`@@ -339,13 +351,15 @@ return [`
`339`	`351`	`$$ LANGUAGE plperl;`
`340`	`352`	`SELECT * FROM foo_set_bad();`
`341`	`353`	`ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash`
	`354`	`+CONTEXT: PL/Perl function "foo_set_bad"`
`342`	`355`	`CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$`
`343`	`356`	`return [`
`344`	`357`	`{y => 3, z => 4}`
`345`	`358`	`];`
`346`	`359`	`$$ LANGUAGE plperl;`
`347`	`360`	`SELECT * FROM foo_set_bad();`
`348`	`361`	`ERROR: Perl hash contains nonexistent column "z"`
	`362`	`+CONTEXT: PL/Perl function "foo_set_bad"`
`349`	`363`	`--`
`350`	`364`	`-- Check passing a tuple argument`
`351`	`365`	`--`
`@@ -539,4 +553,5 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS doubl`
`539`	`553`	`return $result;`
`540`	`554`	`$$ LANGUAGE plperl;`
`541`	`555`	`SELECT perl_spi_prepared_bad(4.35) as "double precision";`
`542`		`-ERROR: error from Perl function "perl_spi_prepared_bad": type "does_not_exist" does not exist at line 2.`
	`556`	`+ERROR: type "does_not_exist" does not exist at line 2.`
	`557`	`+CONTEXT: PL/Perl function "perl_spi_prepared_bad"`

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

Lines changed: 4 additions & 1 deletion

Original file line number	Diff line number	Diff line change
`@@ -7,6 +7,7 @@ create or replace function perl_elog(text) returns void language plperl as $$`
`7`	`7`	`$$;`
`8`	`8`	`select perl_elog('explicit elog');`
`9`	`9`	`NOTICE: explicit elog`
	`10`	`+CONTEXT: PL/Perl function "perl_elog"`
`10`	`11`	`perl_elog`
`11`	`12`	`-----------`
`12`	`13`
`@@ -21,6 +22,7 @@ $$;`
`21`	`22`	`select perl_warn('implicit elog via warn');`
`22`	`23`	`NOTICE: implicit elog via warn at line 4.`
`23`	`24`
	`25`	`+CONTEXT: PL/Perl function "perl_warn"`
`24`	`26`	`perl_warn`
`25`	`27`	`-----------`
`26`	`28`
`@@ -35,8 +37,9 @@ create or replace function uses_global() returns text language plperl as $$`
`35`	`37`	`return 'uses_global worked';`
`36`	`38`
`37`	`39`	`$$;`
`38`		`-ERROR:creation of Perl function "uses_global" failed:Global symbol "$global" requires explicit package name at line 3.`
	`40`	`+ERROR: Global symbol "$global" requires explicit package name at line 3.`
`39`	`41`	`Global symbol "$other_global" requires explicit package name at line 4.`
	`42`	`+CONTEXT: compilation of PL/Perl function "uses_global"`
`40`	`43`	`select uses_global();`
`41`	`44`	`ERROR: function uses_global() does not exist`
`42`	`45`	`LINE 1: select uses_global();`

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

Lines changed: 34 additions & 0 deletions

Original file line number	Diff line number	Diff line change
`@@ -53,41 +53,75 @@ BEFORE INSERT OR UPDATE OR DELETE ON trigger_test`
`53`	`53`	`FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo');`
`54`	`54`	`insert into trigger_test values(1,'insert');`
`55`	`55`	`NOTICE: $_TD->{argc} = '2'`
	`56`	`+CONTEXT: PL/Perl function "trigger_data"`
`56`	`57`	`NOTICE: $_TD->{args} = ['23', 'skidoo']`
	`58`	`+CONTEXT: PL/Perl function "trigger_data"`
`57`	`59`	`NOTICE: $_TD->{event} = 'INSERT'`
	`60`	`+CONTEXT: PL/Perl function "trigger_data"`
`58`	`61`	`NOTICE: $_TD->{level} = 'ROW'`
	`62`	`+CONTEXT: PL/Perl function "trigger_data"`
`59`	`63`	`NOTICE: $_TD->{name} = 'show_trigger_data_trig'`
	`64`	`+CONTEXT: PL/Perl function "trigger_data"`
`60`	`65`	`NOTICE: $_TD->{new} = {'i' => '1', 'v' => 'insert'}`
	`66`	`+CONTEXT: PL/Perl function "trigger_data"`
`61`	`67`	`NOTICE: $_TD->{relid} = 'bogus:12345'`
	`68`	`+CONTEXT: PL/Perl function "trigger_data"`
`62`	`69`	`NOTICE: $_TD->{relname} = 'trigger_test'`
	`70`	`+CONTEXT: PL/Perl function "trigger_data"`
`63`	`71`	`NOTICE: $_TD->{table_name} = 'trigger_test'`
	`72`	`+CONTEXT: PL/Perl function "trigger_data"`
`64`	`73`	`NOTICE: $_TD->{table_schema} = 'public'`
	`74`	`+CONTEXT: PL/Perl function "trigger_data"`
`65`	`75`	`NOTICE: $_TD->{when} = 'BEFORE'`
	`76`	`+CONTEXT: PL/Perl function "trigger_data"`
`66`	`77`	`update trigger_test set v = 'update' where i = 1;`
`67`	`78`	`NOTICE: $_TD->{argc} = '2'`
	`79`	`+CONTEXT: PL/Perl function "trigger_data"`
`68`	`80`	`NOTICE: $_TD->{args} = ['23', 'skidoo']`
	`81`	`+CONTEXT: PL/Perl function "trigger_data"`
`69`	`82`	`NOTICE: $_TD->{event} = 'UPDATE'`
	`83`	`+CONTEXT: PL/Perl function "trigger_data"`
`70`	`84`	`NOTICE: $_TD->{level} = 'ROW'`
	`85`	`+CONTEXT: PL/Perl function "trigger_data"`
`71`	`86`	`NOTICE: $_TD->{name} = 'show_trigger_data_trig'`
	`87`	`+CONTEXT: PL/Perl function "trigger_data"`
`72`	`88`	`NOTICE: $_TD->{new} = {'i' => '1', 'v' => 'update'}`
	`89`	`+CONTEXT: PL/Perl function "trigger_data"`
`73`	`90`	`NOTICE: $_TD->{old} = {'i' => '1', 'v' => 'insert'}`
	`91`	`+CONTEXT: PL/Perl function "trigger_data"`
`74`	`92`	`NOTICE: $_TD->{relid} = 'bogus:12345'`
	`93`	`+CONTEXT: PL/Perl function "trigger_data"`
`75`	`94`	`NOTICE: $_TD->{relname} = 'trigger_test'`
	`95`	`+CONTEXT: PL/Perl function "trigger_data"`
`76`	`96`	`NOTICE: $_TD->{table_name} = 'trigger_test'`
	`97`	`+CONTEXT: PL/Perl function "trigger_data"`
`77`	`98`	`NOTICE: $_TD->{table_schema} = 'public'`
	`99`	`+CONTEXT: PL/Perl function "trigger_data"`
`78`	`100`	`NOTICE: $_TD->{when} = 'BEFORE'`
	`101`	`+CONTEXT: PL/Perl function "trigger_data"`
`79`	`102`	`delete from trigger_test;`
`80`	`103`	`NOTICE: $_TD->{argc} = '2'`
	`104`	`+CONTEXT: PL/Perl function "trigger_data"`
`81`	`105`	`NOTICE: $_TD->{args} = ['23', 'skidoo']`
	`106`	`+CONTEXT: PL/Perl function "trigger_data"`
`82`	`107`	`NOTICE: $_TD->{event} = 'DELETE'`
	`108`	`+CONTEXT: PL/Perl function "trigger_data"`
`83`	`109`	`NOTICE: $_TD->{level} = 'ROW'`
	`110`	`+CONTEXT: PL/Perl function "trigger_data"`
`84`	`111`	`NOTICE: $_TD->{name} = 'show_trigger_data_trig'`
	`112`	`+CONTEXT: PL/Perl function "trigger_data"`
`85`	`113`	`NOTICE: $_TD->{old} = {'i' => '1', 'v' => 'update'}`
	`114`	`+CONTEXT: PL/Perl function "trigger_data"`
`86`	`115`	`NOTICE: $_TD->{relid} = 'bogus:12345'`
	`116`	`+CONTEXT: PL/Perl function "trigger_data"`
`87`	`117`	`NOTICE: $_TD->{relname} = 'trigger_test'`
	`118`	`+CONTEXT: PL/Perl function "trigger_data"`
`88`	`119`	`NOTICE: $_TD->{table_name} = 'trigger_test'`
	`120`	`+CONTEXT: PL/Perl function "trigger_data"`
`89`	`121`	`NOTICE: $_TD->{table_schema} = 'public'`
	`122`	`+CONTEXT: PL/Perl function "trigger_data"`
`90`	`123`	`NOTICE: $_TD->{when} = 'BEFORE'`
	`124`	`+CONTEXT: PL/Perl function "trigger_data"`
`91`	`125`
`92`	`126`	`DROP TRIGGER show_trigger_data_trig on trigger_test;`
`93`	`127`

`‎src/pl/plperl/plperl.c`

Lines changed: 58 additions & 10 deletions

Original file line number	Diff line number	Diff line change
`@@ -1,7 +1,7 @@`
`1`	`1`	`/**********************************************************************`
`2`	`2`	`* plperl.c - perl as a procedural language for PostgreSQL`
`3`	`3`	`*`
`4`		`- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.150 2009/06/11 14:49:14 momjian Exp $`
	`4`	`+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.151 2009/09/16 06:06:12 petere Exp $`
`5`	`5`	`*`
`6`	`6`	`**********************************************************************/`
`7`	`7`
`@@ -162,6 +162,8 @@ static SV *hv_store_string(HV hv, const char key, SV val);`
`162`	`162`	`staticSV*hv_fetch_string(HVhv,constchar*key);`
`163`	`163`	`staticSVplperl_create_sub(charproname,char*s,booltrusted);`
`164`	`164`	`staticSVplperl_call_perl_func(plperl_proc_descdesc,FunctionCallInfofcinfo);`
	`165`	`+staticvoidplperl_compile_callback(void*arg);`
	`166`	`+staticvoidplperl_exec_callback(void*arg);`
`165`	`167`
`166`	`168`	`/*`
`167`	`169`	`* This routine is a crock, and so is everyplace that calls it. The problem`
`@@ -1019,9 +1021,7 @@ plperl_create_sub(char proname, char s, bool trusted)`
`1019`	`1021`	`LEAVE;`
`1020`	`1022`	`ereport(ERROR,`
`1021`	`1023`	`(errcode(ERRCODE_SYNTAX_ERROR),`
`1022`		`-errmsg("creation of Perl function \"%s\" failed: %s",`
`1023`		`-proname,`
`1024`		`-strip_trailing_ws(SvPV(ERRSV,PL_na)))));`
	`1024`	`+errmsg("%s",strip_trailing_ws(SvPV(ERRSV,PL_na)))));`
`1025`	`1025`	`}`
`1026`	`1026`
`1027`	`1027`	`/*`
`@@ -1149,9 +1149,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)`
`1149`	`1149`	`LEAVE;`
`1150`	`1150`	`/* XXX need to find a way to assign an errcode here */`
`1151`	`1151`	`ereport(ERROR,`
`1152`		`-(errmsg("error from Perl function \"%s\": %s",`
`1153`		`-desc->proname,`
`1154`		`-strip_trailing_ws(SvPV(ERRSV,PL_na)))));`
	`1152`	`+(errmsg("%s",strip_trailing_ws(SvPV(ERRSV,PL_na)))));`
`1155`	`1153`	`}`
`1156`	`1154`
`1157`	`1155`	`retval=newSVsv(POPs);`
`@@ -1207,9 +1205,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,`
`1207`	`1205`	`LEAVE;`
`1208`	`1206`	`/* XXX need to find a way to assign an errcode here */`
`1209`	`1207`	`ereport(ERROR,`
`1210`		`-(errmsg("error from Perl function \"%s\": %s",`
`1211`		`-desc->proname,`
`1212`		`-strip_trailing_ws(SvPV(ERRSV,PL_na)))));`
	`1208`	`+(errmsg("%s",strip_trailing_ws(SvPV(ERRSV,PL_na)))));`
`1213`	`1209`	`}`
`1214`	`1210`
`1215`	`1211`	`retval=newSVsv(POPs);`
`@@ -1231,6 +1227,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)`
`1231`	`1227`	`ReturnSetInfo*rsi;`
`1232`	`1228`	`SV*array_ret=NULL;`
`1233`	`1229`	`boololdcontext=trusted_context;`
	`1230`	`+ErrorContextCallbackpl_error_context;`
`1234`	`1231`
`1235`	`1232`	`/*`
`1236`	`1233`	`* Create the call_data beforing connecting to SPI, so that it is not`
`@@ -1245,6 +1242,12 @@ plperl_func_handler(PG_FUNCTION_ARGS)`
`1245`	`1242`	`prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, false);`
`1246`	`1243`	`current_call_data->prodesc=prodesc;`
`1247`	`1244`
	`1245`	`+/* Set a callback for error reporting */`
	`1246`	`+pl_error_context.callback=plperl_exec_callback;`
	`1247`	`+pl_error_context.previous=error_context_stack;`
	`1248`	`+pl_error_context.arg=prodesc->proname;`
	`1249`	`+error_context_stack=&pl_error_context;`
	`1250`	`+`
`1248`	`1251`	`rsi= (ReturnSetInfo*)fcinfo->resultinfo;`
`1249`	`1252`
`1250`	`1253`	`if (prodesc->fn_retisset)`
`@@ -1367,6 +1370,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)`
`1367`	`1370`	`prodesc->result_typioparam,-1);`
`1368`	`1371`	`}`
`1369`	`1372`
	`1373`	`+/* Restore the previous error callback */`
	`1374`	`+error_context_stack=pl_error_context.previous;`
	`1375`	`+`
`1370`	`1376`	`if (array_ret==NULL)`
`1371`	`1377`	`SvREFCNT_dec(perlret);`
`1372`	`1378`
`@@ -1386,6 +1392,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)`
`1386`	`1392`	`SV*svTD;`
`1387`	`1393`	`HV*hvTD;`
`1388`	`1394`	`boololdcontext=trusted_context;`
	`1395`	`+ErrorContextCallbackpl_error_context;`
`1389`	`1396`
`1390`	`1397`	`/*`
`1391`	`1398`	`* Create the call_data beforing connecting to SPI, so that it is not`
`@@ -1402,6 +1409,12 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)`
`1402`	`1409`	`prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, true);`
`1403`	`1410`	`current_call_data->prodesc=prodesc;`
`1404`	`1411`
	`1412`	`+/* Set a callback for error reporting */`
	`1413`	`+pl_error_context.callback=plperl_exec_callback;`
	`1414`	`+pl_error_context.previous=error_context_stack;`
	`1415`	`+pl_error_context.arg=prodesc->proname;`
	`1416`	`+error_context_stack=&pl_error_context;`
	`1417`	`+`
`1405`	`1418`	`check_interp(prodesc->lanpltrusted);`
`1406`	`1419`
`1407`	`1420`	`svTD=plperl_trigger_build_args(fcinfo);`
`@@ -1471,6 +1484,9 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)`
`1471`	`1484`	`retval=PointerGetDatum(trv);`
`1472`	`1485`	`}`
`1473`	`1486`
	`1487`	`+/* Restore the previous error callback */`
	`1488`	`+error_context_stack=pl_error_context.previous;`
	`1489`	`+`
`1474`	`1490`	`SvREFCNT_dec(svTD);`
`1475`	`1491`	`if (perlret)`
`1476`	`1492`	`SvREFCNT_dec(perlret);`
`@@ -1492,6 +1508,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)`
`1492`	`1508`	`plperl_proc_entry*hash_entry;`
`1493`	`1509`	`boolfound;`
`1494`	`1510`	`boololdcontext=trusted_context;`
	`1511`	`+ErrorContextCallbackplperl_error_context;`
`1495`	`1512`
`1496`	`1513`	`/* We'll need the pg_proc tuple in any case... */`
`1497`	`1514`	`procTup=SearchSysCache(PROCOID,`
`@@ -1501,6 +1518,12 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)`
`1501`	`1518`	`elog(ERROR,"cache lookup failed for function %u",fn_oid);`
`1502`	`1519`	`procStruct= (Form_pg_proc)GETSTRUCT(procTup);`
`1503`	`1520`
	`1521`	`+/* Set a callback for reporting compilation errors */`
	`1522`	`+plperl_error_context.callback=plperl_compile_callback;`
	`1523`	`+plperl_error_context.previous=error_context_stack;`
	`1524`	`+plperl_error_context.arg=NameStr(procStruct->proname);`
	`1525`	`+error_context_stack=&plperl_error_context;`
	`1526`	`+`
`1504`	`1527`	`/************************************************************`
`1505`	`1528`	`* Build our internal proc name from the function's Oid`
`1506`	`1529`	`************************************************************/`
`@@ -1731,6 +1754,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)`
`1731`	`1754`	`hash_entry->proc_data=prodesc;`
`1732`	`1755`	`}`
`1733`	`1756`
	`1757`	`+/* restore previous error callback */`
	`1758`	`+error_context_stack=plperl_error_context.previous;`
	`1759`	`+`
`1734`	`1760`	`ReleaseSysCache(procTup);`
`1735`	`1761`
`1736`	`1762`	`returnprodesc;`
`@@ -2683,3 +2709,25 @@ hv_fetch_string(HV hv, const char key)`
`2683`	`2709`	`#endif`
`2684`	`2710`	`returnhv_fetch(hv,key,klen,0);`
`2685`	`2711`	`}`
	`2712`	`+`
	`2713`	`+/*`
	`2714`	`+ * Provide function name for PL/Perl execution errors`
	`2715`	`+ */`
	`2716`	`+staticvoid`
	`2717`	`+plperl_exec_callback(void*arg)`
	`2718`	`+{`
	`2719`	`+charprocname= (char)arg;`
	`2720`	`+if (procname)`
	`2721`	`+errcontext("PL/Perl function \"%s\"",procname);`
	`2722`	`+}`
	`2723`	`+`
	`2724`	`+/*`
	`2725`	`+ * Provide function name for PL/Perl compilation errors`
	`2726`	`+ */`
	`2727`	`+staticvoid`
	`2728`	`+plperl_compile_callback(void*arg)`
	`2729`	`+{`
	`2730`	`+charprocname= (char)arg;`
	`2731`	`+if (procname)`
	`2732`	`+errcontext("compilation of PL/Perl function \"%s\"",procname);`
	`2733`	`+}`

0 commit comments

Comments

(0)

Movatterモバイル変換

Navigation Menu

Search code, repositories, users, issues, pull requests...

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

Commite3f0271

File tree

4 files changed

4 files changed

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

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

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

`‎src/pl/plperl/plperl.c`

0 commit comments