Received: from malur.postgresql.org ([217.196.149.56]) by arkaria.postgresql.org with esmtps (TLS1.3) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.94.2) (envelope-from ) id 1sPSME-004hUI-Nw for pgsql-hackers@arkaria.postgresql.org; Thu, 04 Jul 2024 19:43:07 +0000 Received: from localhost ([127.0.0.1] helo=malur.postgresql.org) by malur.postgresql.org with esmtp (Exim 4.94.2) (envelope-from ) id 1sPSMC-002Sw9-Nh for pgsql-hackers@arkaria.postgresql.org; Thu, 04 Jul 2024 19:43:05 +0000 Received: from magus.postgresql.org ([2a02:c0:301:0:ffff::29]) by malur.postgresql.org with esmtps (TLS1.3) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.94.2) (envelope-from ) id 1sPSMC-002Sw1-Am for pgsql-hackers@lists.postgresql.org; Thu, 04 Jul 2024 19:43:05 +0000 Received: from sss.pgh.pa.us ([68.162.161.243]) by magus.postgresql.org with esmtps (TLS1.3) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.94.2) (envelope-from ) id 1sPSM9-000RIN-PQ for pgsql-hackers@lists.postgresql.org; Thu, 04 Jul 2024 19:43:04 +0000 Received: from sss1.sss.pgh.pa.us (localhost [127.0.0.1]) by sss.pgh.pa.us (8.15.2/8.15.2) with ESMTP id 464JgnhZ078189; Thu, 4 Jul 2024 15:42:49 -0400 From: Tom Lane To: Pavel Stehule cc: Heikki Linnakangas , pgsql-hackers@lists.postgresql.org Subject: Re: Improving PL/Tcl's error context reports In-reply-to: <30397.1720116985@sss.pgh.pa.us> References: <890581.1717609350@sss.pgh.pa.us> <974c2531-536a-4223-a264-166872386459@iki.fi> <26372.1720114586@sss.pgh.pa.us> <30397.1720116985@sss.pgh.pa.us> Comments: In-reply-to Tom Lane message dated "Thu, 04 Jul 2024 14:16:25 -0400" MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="----- =_aaaaaaaaaa0" Content-ID: <78173.1720122158.0@sss.pgh.pa.us> Date: Thu, 04 Jul 2024 15:42:49 -0400 Message-ID: <78188.1720122169@sss.pgh.pa.us> List-Id: List-Help: List-Subscribe: List-Post: List-Owner: List-Archive: Archived-At: Precedence: bulk ------- =_aaaaaaaaaa0 Content-Type: text/plain; charset="us-ascii" Content-ID: <78173.1720122158.1@sss.pgh.pa.us> I wrote: > Pavel Stehule writes: >> PLpgSQL uses more often function signature >> (2024-07-04 19:49:20) postgres=# select bx(0); >> ERROR: division by zero >> CONTEXT: PL/pgSQL function fx(integer) line 1 at RETURN >> PL/pgSQL function bx(integer) line 1 at RETURN > Oh that's a good idea! So let's use format_procedure(), same as > plpgsql does, to generate the final context line that currently > reads like > in PL/Tcl function "bogus" > Then, we could apply the "pull out just alphanumerics" rule to > the result of format_procedure() to generate the internal Tcl name. > That should greatly reduce the number of cases where we have duplicate > internal names we have to unique-ify. Here's a v2 that does it like that. regards, tom lane ------- =_aaaaaaaaaa0 Content-Type: text/x-diff; name="better-pltcl-context-reports-v2.patch"; charset="us-ascii" Content-ID: <78173.1720122158.2@sss.pgh.pa.us> Content-Description: better-pltcl-context-reports-v2.patch Content-Transfer-Encoding: quoted-printable diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml index b31f2c1330..5a8e4c9d37 100644 --- a/doc/src/sgml/pltcl.sgml +++ b/doc/src/sgml/pltcl.sgml @@ -1120,16 +1120,25 @@ CALL transaction_test1(); = In PostgreSQL, 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 differ= ent + 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 co= ntain - the object - ID of the function from the system table pg_proc 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 objec= t + 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, PostgreSQL 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 v= isible when debugging. = + + 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 spi_exec or a related comman= d. + + diff --git a/src/pl/tcl/expected/pltcl_queries.out b/src/pl/tcl/expected/p= ltcl_queries.out index 2d922c2333..42c057b373 100644 --- a/src/pl/tcl/expected/pltcl_queries.out +++ b/src/pl/tcl/expected/pltcl_queries.out @@ -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 reco= rd 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 recor= d 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 ty= pe record select * from tcl_record_result(42); -- fail -ERROR: a column definition list is required for functions returning "rec= ord" at character 15 +ERROR: a column definition list is required for functions returning "rec= ord" +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 c= olumn 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, ER= ROR, 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,55 @@ 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; +select tcls1.somefunc(11); + somefunc = +---------- + 22 +(1 row) + +select tcls2.somefunc(12); + somefunc = +---------- + 36 +(1 row) + +select tcls1.somefunc(13); + somefunc = +---------- + 26 +(1 row) + +-- 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($$ diff --git a/src/pl/tcl/expected/pltcl_transaction.out b/src/pl/tcl/expect= ed/pltcl_transaction.out index f557b79138..cf71b58d48 100644 --- a/src/pl/tcl/expected/pltcl_transaction.out +++ b/src/pl/tcl/expected/pltcl_transaction.out @@ -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 constrain= t "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 = ---- diff --git a/src/pl/tcl/expected/pltcl_trigger.out b/src/pl/tcl/expected/p= ltcl_trigger.out index 008ea19509..129abd5ba6 100644 --- a/src/pl/tcl/expected/pltcl_trigger.out +++ b/src/pl/tcl/expected/pltcl_trigger.out @@ -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 diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 5b9c030c8d..21b2b04593 100644 --- a/src/pl/tcl/pltcl.c +++ b/src/pl/tcl/pltcl.c @@ -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 happe= ns + * while the old proc is being executed, we mustn't remove the struct unt= il + * 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 disappearin= g + * 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 *pr= oname) */ char *emsg; char *econtext; + int emsglen; = emsg =3D pstrdup(utf_u2e(Tcl_GetStringResult(interp))); econtext =3D 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 =3D strlen(emsg); + if (strncmp(emsg, econtext, emsglen) =3D=3D 0 && + econtext[emsglen] =3D=3D '\n') + econtext +=3D emsglen + 1; + + /* Tcl likes to prefix the next line with some spaces, too */ + while (*econtext =3D=3D ' ') + 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 =3D 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 !=3D NULL && + prodesc->internal_proname !=3D NULL && prodesc->fn_xmin =3D=3D 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 =3D 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 =3D pltcl_fetch_interp(procStruct->prolang, pltrusted); + interp =3D 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 !=3D NULL && + prodesc->internal_proname !=3D NULL) + { + /* We simply ignore any error */ + (void) Tcl_DeleteCommand(interp, prodesc->internal_proname); + /* Don't do this more than once */ + prodesc->internal_proname =3D NULL; + } + + /************************************************************ + * Build the proc name we'll use in error messages. + ************************************************************/ + user_proname =3D 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 =3D false; + for (const char *ptr =3D user_proname; *ptr; ptr++) + { + if (strchr("ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz" + "0123456789_", *ptr) !=3D NULL) + { + /* Done this way to avoid adding a trailing underscore */ + if (need_underscore) + { + Tcl_DStringAppend(&proc_internal_name, "_", 1); + need_underscore =3D false; + } + Tcl_DStringAppend(&proc_internal_name, ptr, 1); + } + else if (strchr("(, ", *ptr) !=3D NULL) + need_underscore =3D 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 =3D 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 =3D MemoryContextSwitchTo(proc_cxt); prodesc =3D (pltcl_proc_desc *) palloc0(sizeof(pltcl_proc_desc)); - prodesc->user_proname =3D pstrdup(NameStr(procStruct->proname)); + prodesc->user_proname =3D pstrdup(user_proname); MemoryContextSetIdentifier(proc_cxt, prodesc->user_proname); prodesc->internal_proname =3D pstrdup(internal_proname); prodesc->fn_cxt =3D proc_cxt; @@ -1513,13 +1601,8 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid, (procStruct->provolatile !=3D PROVOLATILE_VOLATILE); /* And whether it is trusted */ prodesc->lanpltrusted =3D pltrusted; - - /************************************************************ - * Identify the interpreter to use for the function - ************************************************************/ - prodesc->interp_desc =3D pltcl_fetch_interp(procStruct->prolang, - prodesc->lanpltrusted); - interp =3D prodesc->interp_desc->interp; + /* Save the associated interpreter, too */ + prodesc->interp_desc =3D 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); diff --git a/src/pl/tcl/sql/pltcl_queries.sql b/src/pl/tcl/sql/pltcl_queri= es.sql index bbd2d97999..ff2d8e1a72 100644 --- a/src/pl/tcl/sql/pltcl_queries.sql +++ b/src/pl/tcl/sql/pltcl_queries.sql @@ -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,35 @@ 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; + +select tcls1.somefunc(11); +select tcls2.somefunc(12); +select tcls1.somefunc(13); + +-- 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($$ diff --git a/src/pl/tcl/sql/pltcl_transaction.sql b/src/pl/tcl/sql/pltcl_t= ransaction.sql index bd759850a7..0784b7cd9f 100644 --- a/src/pl/tcl/sql/pltcl_transaction.sql +++ b/src/pl/tcl/sql/pltcl_transaction.sql @@ -1,6 +1,3 @@ --- suppress CONTEXT so that function OIDs aren't in output -\set VERBOSITY terse - CREATE TABLE test1 (a int, b text); = = diff --git a/src/pl/tcl/sql/pltcl_trigger.sql b/src/pl/tcl/sql/pltcl_trigg= er.sql index 2db75a333a..2a244de83b 100644 --- a/src/pl/tcl/sql/pltcl_trigger.sql +++ b/src/pl/tcl/sql/pltcl_trigger.sql @@ -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 = -- ------- =_aaaaaaaaaa0--