Improve PL/Tcl's method for choosing Tcl names of procedures.
Previously, the internal name of a PL/Tcl function was just "__PLTcl_proc_NNNN", where NNNN is the function OID. That's pretty unhelpful when reading an error report. Plus it prevents us from testing the CONTEXT output for PL/Tcl errors, since the OIDs shown in the regression tests wouldn't be stable. Instead, base the internal name on the result of format_procedure(), which will be unique in most cases. For the edge cases where it's not, we can append the function OID to make it unique. Sadly, the pltcl_trigger.sql test script still has to suppress the context reports, because they'd include trigger arguments which contain relation OIDs per PL/Tcl's longstanding API for triggers. I had to modify one existing test case to throw a different error than before, because I found that Tcl 8.5 and Tcl 8.6 spell the context message for the original error slightly differently. We might have to make more adjustments in that vein once this gets wider testing. Patch by me; thanks to Pavel Stehule for the idea to use format_procedure() rather than just the proname. Discussion: https://postgr.es/m/890581.1717609350@sss.pgh.pa.us
This commit is contained in:
Tom Lane
parent
aaab3ee9c6
commit
ba8f00eef6
@ -1120,16 +1120,25 @@ CALL transaction_test1();
|
||||
|
||||
<para>
|
||||
In <productname>PostgreSQL</productname>, the same function name can be used for
|
||||
different function definitions as long as the number of arguments or their types
|
||||
different function definitions if the functions are placed in different
|
||||
schemas, or if the number of arguments or their types
|
||||
differ. Tcl, however, requires all procedure names to be distinct.
|
||||
PL/Tcl deals with this by making the internal Tcl procedure names contain
|
||||
the object
|
||||
ID of the function from the system table <structname>pg_proc</structname> as part of their name. Thus,
|
||||
PL/Tcl deals with this by including the argument type names in the
|
||||
internal Tcl procedure name, and then appending the function's object
|
||||
ID (OID) to the internal Tcl procedure name if necessary to make it
|
||||
different from the names of all previously-loaded functions in the
|
||||
same Tcl interpreter. Thus,
|
||||
<productname>PostgreSQL</productname> functions with the same name
|
||||
and different argument types will be different Tcl procedures, too. This
|
||||
is not normally a concern for a PL/Tcl programmer, but it might be visible
|
||||
when debugging.
|
||||
</para>
|
||||
|
||||
<para>
|
||||
For this reason among others, a PL/Tcl function cannot call another one
|
||||
directly (that is, within Tcl). If you need to do that, you must go
|
||||
through SQL, using <function>spi_exec</function> or a related command.
|
||||
</para>
|
||||
|
||||
</sect1>
|
||||
</chapter>
|
||||
|
||||
@ -1,5 +1,3 @@
|
||||
-- suppress CONTEXT so that function OIDs aren't in output
|
||||
\set VERBOSITY terse
|
||||
-- Test composite-type arguments
|
||||
select tcl_composite_arg_ref1(row('tkey', 42, 'ref2'));
|
||||
tcl_composite_arg_ref1
|
||||
@ -73,9 +71,15 @@ select tcl_argisnull(null);
|
||||
(1 row)
|
||||
|
||||
-- test some error cases
|
||||
create function tcl_error(out a int, out b int) as $$return {$$ language pltcl;
|
||||
create function tcl_error(out a int, out b int) as $$returm 1$$ language pltcl;
|
||||
select tcl_error();
|
||||
ERROR: missing close-brace
|
||||
ERROR: invalid command name "returm"
|
||||
CONTEXT: while executing
|
||||
"returm 1"
|
||||
(procedure "__PLTcl_proc_tcl_error" line 2)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_error"
|
||||
in PL/Tcl function tcl_error()
|
||||
create function bad_record(out a text, out b text) as $$return [list a]$$ language pltcl;
|
||||
select bad_record();
|
||||
ERROR: column name/value list must have even number of elements
|
||||
@ -123,16 +127,34 @@ select 1, tcl_test_sequence(0,5);
|
||||
create function non_srf() returns int as $$return_next 1$$ language pltcl;
|
||||
select non_srf();
|
||||
ERROR: return_next cannot be used in non-set-returning functions
|
||||
CONTEXT: while executing
|
||||
"return_next 1"
|
||||
(procedure "__PLTcl_proc_non_srf" line 2)
|
||||
invoked from within
|
||||
"__PLTcl_proc_non_srf"
|
||||
in PL/Tcl function non_srf()
|
||||
create function bad_record_srf(out a text, out b text) returns setof record as $$
|
||||
return_next [list a]
|
||||
$$ language pltcl;
|
||||
select bad_record_srf();
|
||||
ERROR: column name/value list must have even number of elements
|
||||
CONTEXT: while executing
|
||||
"return_next [list a]"
|
||||
(procedure "__PLTcl_proc_bad_record_srf" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_bad_record_srf"
|
||||
in PL/Tcl function bad_record_srf()
|
||||
create function bad_field_srf(out a text, out b text) returns setof record as $$
|
||||
return_next [list a 1 b 2 cow 3]
|
||||
$$ language pltcl;
|
||||
select bad_field_srf();
|
||||
ERROR: column name/value list contains nonexistent column name "cow"
|
||||
CONTEXT: while executing
|
||||
"return_next [list a 1 b 2 cow 3]"
|
||||
(procedure "__PLTcl_proc_bad_field_srf" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_bad_field_srf"
|
||||
in PL/Tcl function bad_field_srf()
|
||||
-- test composite and domain-over-composite results
|
||||
create function tcl_composite_result(int) returns T_comp1 as $$
|
||||
return [list tkey tkey1 ref1 $1 ref2 ref22]
|
||||
@ -172,7 +194,9 @@ $$ language pltcl;
|
||||
select tcl_record_result(42); -- fail
|
||||
ERROR: function returning record called in context that cannot accept type record
|
||||
select * from tcl_record_result(42); -- fail
|
||||
ERROR: a column definition list is required for functions returning "record" at character 15
|
||||
ERROR: a column definition list is required for functions returning "record"
|
||||
LINE 1: select * from tcl_record_result(42);
|
||||
^
|
||||
select * from tcl_record_result(42) as (q1 text, q2 int, q3 text);
|
||||
q1 | q2 | q3
|
||||
----------+----+----------
|
||||
@ -190,6 +214,15 @@ ERROR: column name/value list contains nonexistent column name "q3"
|
||||
-- test quote
|
||||
select tcl_eval('quote foo bar');
|
||||
ERROR: wrong # args: should be "quote string"
|
||||
CONTEXT: while executing
|
||||
"quote foo bar"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {quote foo bar}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('quote [format %c 39]');
|
||||
tcl_eval
|
||||
----------
|
||||
@ -205,46 +238,217 @@ select tcl_eval('quote [format %c 92]');
|
||||
-- Test argisnull
|
||||
select tcl_eval('argisnull');
|
||||
ERROR: wrong # args: should be "argisnull argno"
|
||||
CONTEXT: while executing
|
||||
"argisnull"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text argisnull"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('argisnull 14');
|
||||
ERROR: argno out of range
|
||||
CONTEXT: while executing
|
||||
"argisnull 14"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {argisnull 14}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('argisnull abc');
|
||||
ERROR: expected integer but got "abc"
|
||||
CONTEXT: while executing
|
||||
"argisnull abc"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {argisnull abc}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
-- Test return_null
|
||||
select tcl_eval('return_null 14');
|
||||
ERROR: wrong # args: should be "return_null "
|
||||
CONTEXT: while executing
|
||||
"return_null 14"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {return_null 14}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
-- Test spi_exec
|
||||
select tcl_eval('spi_exec');
|
||||
ERROR: wrong # args: should be "spi_exec ?-count n? ?-array name? query ?loop body?"
|
||||
CONTEXT: while executing
|
||||
"spi_exec"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text spi_exec"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_exec -count');
|
||||
ERROR: missing argument to -count or -array
|
||||
CONTEXT: while executing
|
||||
"spi_exec -count"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_exec -count}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_exec -array');
|
||||
ERROR: missing argument to -count or -array
|
||||
CONTEXT: while executing
|
||||
"spi_exec -array"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_exec -array}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_exec -count abc');
|
||||
ERROR: expected integer but got "abc"
|
||||
CONTEXT: while executing
|
||||
"spi_exec -count abc"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_exec -count abc}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_exec query loop body toomuch');
|
||||
ERROR: wrong # args: should be "query ?loop body?"
|
||||
CONTEXT: while executing
|
||||
"spi_exec query loop body toomuch"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_exec query loop body toomuch}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_exec "begin; rollback;"');
|
||||
ERROR: pltcl: SPI_execute failed: SPI_ERROR_TRANSACTION
|
||||
CONTEXT: while executing
|
||||
"spi_exec "begin; rollback;""
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_exec "begin; rollback;"}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
-- Test spi_execp
|
||||
select tcl_eval('spi_execp');
|
||||
ERROR: missing argument to -count or -array
|
||||
CONTEXT: while executing
|
||||
"spi_execp"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text spi_execp"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_execp -count');
|
||||
ERROR: missing argument to -array, -count or -nulls
|
||||
CONTEXT: while executing
|
||||
"spi_execp -count"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_execp -count}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_execp -array');
|
||||
ERROR: missing argument to -array, -count or -nulls
|
||||
CONTEXT: while executing
|
||||
"spi_execp -array"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_execp -array}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_execp -count abc');
|
||||
ERROR: expected integer but got "abc"
|
||||
CONTEXT: while executing
|
||||
"spi_execp -count abc"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_execp -count abc}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_execp -nulls');
|
||||
ERROR: missing argument to -array, -count or -nulls
|
||||
CONTEXT: while executing
|
||||
"spi_execp -nulls"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_execp -nulls}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_execp ""');
|
||||
ERROR: invalid queryid ''
|
||||
CONTEXT: while executing
|
||||
"spi_execp """
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_execp ""}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
-- test spi_prepare
|
||||
select tcl_eval('spi_prepare');
|
||||
ERROR: wrong # args: should be "spi_prepare query argtypes"
|
||||
CONTEXT: while executing
|
||||
"spi_prepare"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text spi_prepare"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_prepare a b');
|
||||
ERROR: type "b" does not exist
|
||||
CONTEXT: while executing
|
||||
"spi_prepare a b"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {spi_prepare a b}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('spi_prepare a "b {"');
|
||||
ERROR: unmatched open brace in list
|
||||
CONTEXT: while executing
|
||||
"spi_prepare a "b {""
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text spi_prepare\ a\ \"b\ \{\""
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_error_handling_test($tcl$spi_prepare "select moo" []$tcl$);
|
||||
tcl_error_handling_test
|
||||
--------------------------------------
|
||||
@ -307,11 +511,38 @@ select tcl_error_handling_test('moo');
|
||||
-- test elog
|
||||
select tcl_eval('elog');
|
||||
ERROR: wrong # args: should be "elog level msg"
|
||||
CONTEXT: while executing
|
||||
"elog"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text elog"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
select tcl_eval('elog foo bar');
|
||||
ERROR: bad priority "foo": must be DEBUG, LOG, INFO, NOTICE, WARNING, ERROR, or FATAL
|
||||
CONTEXT: while executing
|
||||
"elog foo bar"
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {elog foo bar}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
-- test forced error
|
||||
select tcl_eval('error "forced error"');
|
||||
ERROR: forced error
|
||||
CONTEXT: while executing
|
||||
"error "forced error""
|
||||
("eval" body line 1)
|
||||
invoked from within
|
||||
"eval $1"
|
||||
(procedure "__PLTcl_proc_tcl_eval_text" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_eval_text {error "forced error"}"
|
||||
in PL/Tcl function tcl_eval(text)
|
||||
-- test loop control in spi_exec[p]
|
||||
select tcl_spi_exec(true, 'break');
|
||||
NOTICE: col1 1, col2 foo
|
||||
@ -339,6 +570,19 @@ NOTICE: col1 1, col2 foo
|
||||
NOTICE: col1 2, col2 bar
|
||||
NOTICE: action: error
|
||||
ERROR: error message
|
||||
CONTEXT: while executing
|
||||
"error "error message""
|
||||
invoked from within
|
||||
"spi_execp -array A $prep {
|
||||
elog NOTICE "col1 $A(col1), col2 $A(col2)"
|
||||
|
||||
switch $A(col1) {
|
||||
2 {
|
||||
elog NOTICE "..."
|
||||
(procedure "__PLTcl_proc_tcl_spi_exec_boolean_text" line 6)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_spi_exec_boolean_text t error"
|
||||
in PL/Tcl function tcl_spi_exec(boolean,text)
|
||||
select tcl_spi_exec(true, 'return');
|
||||
NOTICE: col1 1, col2 foo
|
||||
NOTICE: col1 2, col2 bar
|
||||
@ -374,6 +618,19 @@ NOTICE: col1 1, col2 foo
|
||||
NOTICE: col1 2, col2 bar
|
||||
NOTICE: action: error
|
||||
ERROR: error message
|
||||
CONTEXT: while executing
|
||||
"error "error message""
|
||||
invoked from within
|
||||
"spi_exec -array A $query {
|
||||
elog NOTICE "col1 $A(col1), col2 $A(col2)"
|
||||
|
||||
switch $A(col1) {
|
||||
2 {
|
||||
elog NOTICE "..."
|
||||
(procedure "__PLTcl_proc_tcl_spi_exec_boolean_text" line 31)
|
||||
invoked from within
|
||||
"__PLTcl_proc_tcl_spi_exec_boolean_text f error"
|
||||
in PL/Tcl function tcl_spi_exec(boolean,text)
|
||||
select tcl_spi_exec(false, 'return');
|
||||
NOTICE: col1 1, col2 foo
|
||||
NOTICE: col1 2, col2 bar
|
||||
@ -383,6 +640,59 @@ NOTICE: action: return
|
||||
|
||||
(1 row)
|
||||
|
||||
-- test that we don't get confused by multiple funcs with same SQL name
|
||||
create schema tcls1;
|
||||
create function tcls1.somefunc(int) returns int as $$
|
||||
return [expr $1 * 2]
|
||||
$$ language pltcl;
|
||||
create schema tcls2;
|
||||
create function tcls2.somefunc(int) returns int as $$
|
||||
return [expr $1 * 3]
|
||||
$$ language pltcl;
|
||||
set search_path = tcls1;
|
||||
select tcls1.somefunc(11);
|
||||
somefunc
|
||||
----------
|
||||
22
|
||||
(1 row)
|
||||
|
||||
set search_path = tcls2;
|
||||
select tcls2.somefunc(12);
|
||||
somefunc
|
||||
----------
|
||||
36
|
||||
(1 row)
|
||||
|
||||
set search_path = tcls1;
|
||||
select tcls1.somefunc(13);
|
||||
somefunc
|
||||
----------
|
||||
26
|
||||
(1 row)
|
||||
|
||||
reset search_path;
|
||||
-- test that it works to replace a function that's being executed
|
||||
create function replaceme(text) returns text as $p$
|
||||
spi_exec {
|
||||
create or replace function replaceme(text) returns text as $$
|
||||
return "$1 fum"
|
||||
$$ language pltcl;
|
||||
}
|
||||
spi_exec {select replaceme('foe') as inner}
|
||||
return "fee $1 $inner"
|
||||
$p$ language pltcl;
|
||||
select replaceme('fie');
|
||||
replaceme
|
||||
-----------------
|
||||
fee fie foe fum
|
||||
(1 row)
|
||||
|
||||
select replaceme('fie');
|
||||
replaceme
|
||||
-----------
|
||||
fie fum
|
||||
(1 row)
|
||||
|
||||
-- forcibly run the Tcl event loop for awhile, to check that we have not
|
||||
-- messed things up too badly by disabling the Tcl notifier subsystem
|
||||
select tcl_eval($$
|
||||
|
||||
@ -1,5 +1,3 @@
|
||||
-- suppress CONTEXT so that function OIDs aren't in output
|
||||
\set VERBOSITY terse
|
||||
CREATE TABLE test1 (a int, b text);
|
||||
CREATE PROCEDURE transaction_test1()
|
||||
LANGUAGE pltcl
|
||||
@ -41,6 +39,12 @@ return 1
|
||||
$$;
|
||||
SELECT transaction_test2();
|
||||
ERROR: invalid transaction termination
|
||||
CONTEXT: while executing
|
||||
"commit"
|
||||
(procedure "__PLTcl_proc_transaction_test2" line 6)
|
||||
invoked from within
|
||||
"__PLTcl_proc_transaction_test2"
|
||||
in PL/Tcl function transaction_test2()
|
||||
SELECT * FROM test1;
|
||||
a | b
|
||||
---+---
|
||||
@ -55,6 +59,17 @@ return 1
|
||||
$$;
|
||||
SELECT transaction_test3();
|
||||
ERROR: invalid transaction termination
|
||||
CONTEXT: while executing
|
||||
"commit"
|
||||
(procedure "__PLTcl_proc_transaction_test1" line 6)
|
||||
invoked from within
|
||||
"__PLTcl_proc_transaction_test1"
|
||||
invoked from within
|
||||
"spi_exec "CALL transaction_test1()""
|
||||
(procedure "__PLTcl_proc_transaction_test3" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_transaction_test3"
|
||||
in PL/Tcl function transaction_test3()
|
||||
SELECT * FROM test1;
|
||||
a | b
|
||||
---+---
|
||||
@ -74,6 +89,17 @@ spi_exec -array row "SELECT * FROM test2 ORDER BY x" {
|
||||
$$;
|
||||
CALL transaction_test4a();
|
||||
ERROR: cannot commit while a subtransaction is active
|
||||
CONTEXT: while executing
|
||||
"commit"
|
||||
invoked from within
|
||||
"spi_exec -array row "SELECT * FROM test2 ORDER BY x" {
|
||||
spi_exec "INSERT INTO test1 (a) VALUES ($row(x))"
|
||||
commit
|
||||
}"
|
||||
(procedure "__PLTcl_proc_transaction_test4a" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_transaction_test4a"
|
||||
in PL/Tcl function transaction_test4a()
|
||||
SELECT * FROM test1;
|
||||
a | b
|
||||
---+---
|
||||
@ -91,6 +117,17 @@ spi_exec -array row "SELECT * FROM test2 ORDER BY x" {
|
||||
$$;
|
||||
CALL transaction_test4b();
|
||||
ERROR: cannot roll back while a subtransaction is active
|
||||
CONTEXT: while executing
|
||||
"rollback"
|
||||
invoked from within
|
||||
"spi_exec -array row "SELECT * FROM test2 ORDER BY x" {
|
||||
spi_exec "INSERT INTO test1 (a) VALUES ($row(x))"
|
||||
rollback
|
||||
}"
|
||||
(procedure "__PLTcl_proc_transaction_test4b" line 3)
|
||||
invoked from within
|
||||
"__PLTcl_proc_transaction_test4b"
|
||||
in PL/Tcl function transaction_test4b()
|
||||
SELECT * FROM test1;
|
||||
a | b
|
||||
---+---
|
||||
@ -109,6 +146,12 @@ elog WARNING "should not get here"
|
||||
$$;
|
||||
CALL transaction_testfk();
|
||||
ERROR: insert or update on table "testfk" violates foreign key constraint "testfk_f1_fkey"
|
||||
CONTEXT: while executing
|
||||
"commit"
|
||||
(procedure "__PLTcl_proc_transaction_testfk" line 5)
|
||||
invoked from within
|
||||
"__PLTcl_proc_transaction_testfk"
|
||||
in PL/Tcl function transaction_testfk()
|
||||
SELECT * FROM testpk;
|
||||
id
|
||||
----
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- suppress CONTEXT so that function OIDs aren't in output
|
||||
-- suppress CONTEXT so that table OIDs aren't in output
|
||||
\set VERBOSITY terse
|
||||
--
|
||||
-- Create the tables used in the test queries
|
||||
|
||||
@ -124,19 +124,21 @@ typedef struct pltcl_interp_desc
|
||||
* The pltcl_proc_desc struct itself, as well as all subsidiary data,
|
||||
* is stored in the memory context identified by the fn_cxt field.
|
||||
* We can reclaim all the data by deleting that context, and should do so
|
||||
* when the fn_refcount goes to zero. (But note that we do not bother
|
||||
* trying to clean up Tcl's copy of the procedure definition: it's Tcl's
|
||||
* problem to manage its memory when we replace a proc definition. We do
|
||||
* not clean up pltcl_proc_descs when a pg_proc row is deleted, only when
|
||||
* it is updated, and the same policy applies to Tcl's copy as well.)
|
||||
* when the fn_refcount goes to zero. That will happen if we build a new
|
||||
* pltcl_proc_desc following an update of the pg_proc row. If that happens
|
||||
* while the old proc is being executed, we mustn't remove the struct until
|
||||
* execution finishes. When building a new pltcl_proc_desc, we unlink
|
||||
* Tcl's copy of the old procedure definition, similarly relying on Tcl's
|
||||
* internal reference counting to prevent that structure from disappearing
|
||||
* while it's in use.
|
||||
*
|
||||
* Note that the data in this struct is shared across all active calls;
|
||||
* nothing except the fn_refcount should be changed by a call instance.
|
||||
**********************************************************************/
|
||||
typedef struct pltcl_proc_desc
|
||||
{
|
||||
char *user_proname; /* user's name (from pg_proc.proname) */
|
||||
char *internal_proname; /* Tcl name (based on function OID) */
|
||||
char *user_proname; /* user's name (from format_procedure) */
|
||||
char *internal_proname; /* Tcl proc name (NULL if deleted) */
|
||||
MemoryContext fn_cxt; /* memory context for this procedure */
|
||||
unsigned long fn_refcount; /* number of active references */
|
||||
TransactionId fn_xmin; /* xmin of pg_proc row */
|
||||
@ -1375,13 +1377,29 @@ throw_tcl_error(Tcl_Interp *interp, const char *proname)
|
||||
*/
|
||||
char *emsg;
|
||||
char *econtext;
|
||||
int emsglen;
|
||||
|
||||
emsg = pstrdup(utf_u2e(Tcl_GetStringResult(interp)));
|
||||
econtext = utf_u2e(Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY));
|
||||
|
||||
/*
|
||||
* Typically, the first line of errorInfo matches the primary error
|
||||
* message (the interpreter result); don't print that twice if so.
|
||||
*/
|
||||
emsglen = strlen(emsg);
|
||||
if (strncmp(emsg, econtext, emsglen) == 0 &&
|
||||
econtext[emsglen] == '\n')
|
||||
econtext += emsglen + 1;
|
||||
|
||||
/* Tcl likes to prefix the next line with some spaces, too */
|
||||
while (*econtext == ' ')
|
||||
econtext++;
|
||||
|
||||
/* Note: proname will already contain quoting if any is needed */
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
||||
errmsg("%s", emsg),
|
||||
errcontext("%s\nin PL/Tcl function \"%s\"",
|
||||
errcontext("%s\nin PL/Tcl function %s",
|
||||
econtext, proname)));
|
||||
}
|
||||
|
||||
@ -1405,6 +1423,7 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
|
||||
pltcl_proc_desc *old_prodesc;
|
||||
volatile MemoryContext proc_cxt = NULL;
|
||||
Tcl_DString proc_internal_def;
|
||||
Tcl_DString proc_internal_name;
|
||||
Tcl_DString proc_internal_body;
|
||||
|
||||
/* We'll need the pg_proc tuple in any case... */
|
||||
@ -1435,6 +1454,7 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
|
||||
* function's pg_proc entry without changing its OID.
|
||||
************************************************************/
|
||||
if (prodesc != NULL &&
|
||||
prodesc->internal_proname != NULL &&
|
||||
prodesc->fn_xmin == HeapTupleHeaderGetRawXmin(procTup->t_data) &&
|
||||
ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self))
|
||||
{
|
||||
@ -1452,36 +1472,104 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
|
||||
* Then we load the procedure into the Tcl interpreter.
|
||||
************************************************************/
|
||||
Tcl_DStringInit(&proc_internal_def);
|
||||
Tcl_DStringInit(&proc_internal_name);
|
||||
Tcl_DStringInit(&proc_internal_body);
|
||||
PG_TRY();
|
||||
{
|
||||
bool is_trigger = OidIsValid(tgreloid);
|
||||
char internal_proname[128];
|
||||
Tcl_CmdInfo cmdinfo;
|
||||
const char *user_proname;
|
||||
const char *internal_proname;
|
||||
bool need_underscore;
|
||||
HeapTuple typeTup;
|
||||
Form_pg_type typeStruct;
|
||||
char proc_internal_args[33 * FUNC_MAX_ARGS];
|
||||
Datum prosrcdatum;
|
||||
char *proc_source;
|
||||
char buf[48];
|
||||
pltcl_interp_desc *interp_desc;
|
||||
Tcl_Interp *interp;
|
||||
int i;
|
||||
int tcl_rc;
|
||||
MemoryContext oldcontext;
|
||||
|
||||
/************************************************************
|
||||
* Build our internal proc name from the function's Oid. Append
|
||||
* "_trigger" when appropriate to ensure the normal and trigger
|
||||
* cases are kept separate. Note name must be all-ASCII.
|
||||
* Identify the interpreter to use for the function
|
||||
************************************************************/
|
||||
interp_desc = pltcl_fetch_interp(procStruct->prolang, pltrusted);
|
||||
interp = interp_desc->interp;
|
||||
|
||||
/************************************************************
|
||||
* If redefining the function, try to remove the old internal
|
||||
* procedure from Tcl's namespace. The point of this is partly to
|
||||
* allow re-use of the same internal proc name, and partly to avoid
|
||||
* leaking the Tcl procedure object if we end up not choosing the same
|
||||
* name. We assume that Tcl is smart enough to not physically delete
|
||||
* the procedure object if it's currently being executed.
|
||||
************************************************************/
|
||||
if (prodesc != NULL &&
|
||||
prodesc->internal_proname != NULL)
|
||||
{
|
||||
/* We simply ignore any error */
|
||||
(void) Tcl_DeleteCommand(interp, prodesc->internal_proname);
|
||||
/* Don't do this more than once */
|
||||
prodesc->internal_proname = NULL;
|
||||
}
|
||||
|
||||
/************************************************************
|
||||
* Build the proc name we'll use in error messages.
|
||||
************************************************************/
|
||||
user_proname = format_procedure(fn_oid);
|
||||
|
||||
/************************************************************
|
||||
* Build the internal proc name from the user_proname and/or OID.
|
||||
* The internal name must be all-ASCII since we don't want to deal
|
||||
* with encoding conversions. We don't want to worry about Tcl
|
||||
* quoting rules either, so use only the characters of the function
|
||||
* name that are ASCII alphanumerics, plus underscores to separate
|
||||
* function name and arguments. If what we end up with isn't
|
||||
* unique (that is, it matches some existing Tcl command name),
|
||||
* append the function OID (perhaps repeatedly) so that it is unique.
|
||||
************************************************************/
|
||||
|
||||
/* For historical reasons, use a function-type-specific prefix */
|
||||
if (is_event_trigger)
|
||||
snprintf(internal_proname, sizeof(internal_proname),
|
||||
"__PLTcl_proc_%u_evttrigger", fn_oid);
|
||||
Tcl_DStringAppend(&proc_internal_name,
|
||||
"__PLTcl_evttrigger_", -1);
|
||||
else if (is_trigger)
|
||||
snprintf(internal_proname, sizeof(internal_proname),
|
||||
"__PLTcl_proc_%u_trigger", fn_oid);
|
||||
Tcl_DStringAppend(&proc_internal_name,
|
||||
"__PLTcl_trigger_", -1);
|
||||
else
|
||||
snprintf(internal_proname, sizeof(internal_proname),
|
||||
"__PLTcl_proc_%u", fn_oid);
|
||||
Tcl_DStringAppend(&proc_internal_name,
|
||||
"__PLTcl_proc_", -1);
|
||||
/* Now add what we can from the user_proname */
|
||||
need_underscore = false;
|
||||
for (const char *ptr = user_proname; *ptr; ptr++)
|
||||
{
|
||||
if (strchr("ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
"abcdefghijklmnopqrstuvwxyz"
|
||||
"0123456789_", *ptr) != NULL)
|
||||
{
|
||||
/* Done this way to avoid adding a trailing underscore */
|
||||
if (need_underscore)
|
||||
{
|
||||
Tcl_DStringAppend(&proc_internal_name, "_", 1);
|
||||
need_underscore = false;
|
||||
}
|
||||
Tcl_DStringAppend(&proc_internal_name, ptr, 1);
|
||||
}
|
||||
else if (strchr("(, ", *ptr) != NULL)
|
||||
need_underscore = true;
|
||||
}
|
||||
/* If this name already exists, append fn_oid; repeat as needed */
|
||||
while (Tcl_GetCommandInfo(interp,
|
||||
Tcl_DStringValue(&proc_internal_name),
|
||||
&cmdinfo))
|
||||
{
|
||||
snprintf(buf, sizeof(buf), "_%u", fn_oid);
|
||||
Tcl_DStringAppend(&proc_internal_name, buf, -1);
|
||||
}
|
||||
internal_proname = Tcl_DStringValue(&proc_internal_name);
|
||||
|
||||
/************************************************************
|
||||
* Allocate a context that will hold all PG data for the procedure.
|
||||
@ -1496,7 +1584,7 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
|
||||
************************************************************/
|
||||
oldcontext = MemoryContextSwitchTo(proc_cxt);
|
||||
prodesc = (pltcl_proc_desc *) palloc0(sizeof(pltcl_proc_desc));
|
||||
prodesc->user_proname = pstrdup(NameStr(procStruct->proname));
|
||||
prodesc->user_proname = pstrdup(user_proname);
|
||||
MemoryContextSetIdentifier(proc_cxt, prodesc->user_proname);
|
||||
prodesc->internal_proname = pstrdup(internal_proname);
|
||||
prodesc->fn_cxt = proc_cxt;
|
||||
@ -1513,13 +1601,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
|
||||
(procStruct->provolatile != PROVOLATILE_VOLATILE);
|
||||
/* And whether it is trusted */
|
||||
prodesc->lanpltrusted = pltrusted;
|
||||
|
||||
/************************************************************
|
||||
* Identify the interpreter to use for the function
|
||||
************************************************************/
|
||||
prodesc->interp_desc = pltcl_fetch_interp(procStruct->prolang,
|
||||
prodesc->lanpltrusted);
|
||||
interp = prodesc->interp_desc->interp;
|
||||
/* Save the associated interpreter, too */
|
||||
prodesc->interp_desc = interp_desc;
|
||||
|
||||
/************************************************************
|
||||
* Get the required information for input conversion of the
|
||||
@ -1712,6 +1795,7 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
|
||||
if (proc_cxt)
|
||||
MemoryContextDelete(proc_cxt);
|
||||
Tcl_DStringFree(&proc_internal_def);
|
||||
Tcl_DStringFree(&proc_internal_name);
|
||||
Tcl_DStringFree(&proc_internal_body);
|
||||
PG_RE_THROW();
|
||||
}
|
||||
@ -1740,6 +1824,7 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
|
||||
}
|
||||
|
||||
Tcl_DStringFree(&proc_internal_def);
|
||||
Tcl_DStringFree(&proc_internal_name);
|
||||
Tcl_DStringFree(&proc_internal_body);
|
||||
|
||||
ReleaseSysCache(procTup);
|
||||
|
||||
@ -1,6 +1,3 @@
|
||||
-- suppress CONTEXT so that function OIDs aren't in output
|
||||
\set VERBOSITY terse
|
||||
|
||||
-- Test composite-type arguments
|
||||
select tcl_composite_arg_ref1(row('tkey', 42, 'ref2'));
|
||||
select tcl_composite_arg_ref2(row('tkey', 42, 'ref2'));
|
||||
@ -31,7 +28,7 @@ select tcl_argisnull('');
|
||||
select tcl_argisnull(null);
|
||||
|
||||
-- test some error cases
|
||||
create function tcl_error(out a int, out b int) as $$return {$$ language pltcl;
|
||||
create function tcl_error(out a int, out b int) as $$returm 1$$ language pltcl;
|
||||
select tcl_error();
|
||||
|
||||
create function bad_record(out a text, out b text) as $$return [list a]$$ language pltcl;
|
||||
@ -157,6 +154,39 @@ select tcl_spi_exec(false, 'continue');
|
||||
select tcl_spi_exec(false, 'error');
|
||||
select tcl_spi_exec(false, 'return');
|
||||
|
||||
-- test that we don't get confused by multiple funcs with same SQL name
|
||||
create schema tcls1;
|
||||
create function tcls1.somefunc(int) returns int as $$
|
||||
return [expr $1 * 2]
|
||||
$$ language pltcl;
|
||||
|
||||
create schema tcls2;
|
||||
create function tcls2.somefunc(int) returns int as $$
|
||||
return [expr $1 * 3]
|
||||
$$ language pltcl;
|
||||
|
||||
set search_path = tcls1;
|
||||
select tcls1.somefunc(11);
|
||||
set search_path = tcls2;
|
||||
select tcls2.somefunc(12);
|
||||
set search_path = tcls1;
|
||||
select tcls1.somefunc(13);
|
||||
reset search_path;
|
||||
|
||||
-- test that it works to replace a function that's being executed
|
||||
create function replaceme(text) returns text as $p$
|
||||
spi_exec {
|
||||
create or replace function replaceme(text) returns text as $$
|
||||
return "$1 fum"
|
||||
$$ language pltcl;
|
||||
}
|
||||
spi_exec {select replaceme('foe') as inner}
|
||||
return "fee $1 $inner"
|
||||
$p$ language pltcl;
|
||||
|
||||
select replaceme('fie');
|
||||
select replaceme('fie');
|
||||
|
||||
-- forcibly run the Tcl event loop for awhile, to check that we have not
|
||||
-- messed things up too badly by disabling the Tcl notifier subsystem
|
||||
select tcl_eval($$
|
||||
|
||||
@ -1,6 +1,3 @@
|
||||
-- suppress CONTEXT so that function OIDs aren't in output
|
||||
\set VERBOSITY terse
|
||||
|
||||
CREATE TABLE test1 (a int, b text);
|
||||
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- suppress CONTEXT so that function OIDs aren't in output
|
||||
-- suppress CONTEXT so that table OIDs aren't in output
|
||||
\set VERBOSITY terse
|
||||
|
||||
--
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user