From: Tom Lane <tgl@sss.pgh.pa.us>
To: Pavel Stehule <pavel.stehule@gmail.com>
Cc: Heikki Linnakangas <hlinnaka@iki.fi>
Cc: pgsql-hackers@lists.postgresql.org
Subject: Re: Improving PL/Tcl's error context reports
Date: Thu, 04 Jul 2024 15:42:49 -0400
Message-ID: <78188.1720122169@sss.pgh.pa.us> (raw)
In-Reply-To: <30397.1720116985@sss.pgh.pa.us>
References: <890581.1717609350@sss.pgh.pa.us>
<974c2531-536a-4223-a264-166872386459@iki.fi>
<CAFj8pRBTgCHRacAeygUaLCwggARX5Pxqvs+puduiUuRdx9sYHw@mail.gmail.com>
<26372.1720114586@sss.pgh.pa.us>
<CAFj8pRD4fCxsRGoV3z73cefPoE4GU-W4ORaVK5VNVTpw3PyjKg@mail.gmail.com>
<30397.1720116985@sss.pgh.pa.us>
I wrote:
> Pavel Stehule <pavel.stehule@gmail.com> 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
Attachments:better-pltcl-context-reports-v2.patch (text/x-diff, 31.3K) downloaddiff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgmlindex b31f2c1330..5a8e4c9d37 100644--- a/doc/src/sgml/pltcl.sgml+++ b/doc/src/sgml/pltcl.sgml@@ -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>
diff --git a/src/pl/tcl/expected/pltcl_queries.out b/src/pl/tcl/expected/pltcl_queries.outindex 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 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,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/expected/pltcl_transaction.outindex 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 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
----
diff --git a/src/pl/tcl/expected/pltcl_trigger.out b/src/pl/tcl/expected/pltcl_trigger.outindex 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.cindex 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 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);
diff --git a/src/pl/tcl/sql/pltcl_queries.sql b/src/pl/tcl/sql/pltcl_queries.sqlindex 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_transaction.sqlindex 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_trigger.sqlindex 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
--
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Reply to all the recipients using the --to and --cc options:
reply via email
To: pgsql-hackers@postgresql.org
Cc: tgl@sss.pgh.pa.us, pavel.stehule@gmail.com, hlinnaka@iki.fi, pgsql-hackers@lists.postgresql.org
Subject: Re: Improving PL/Tcl's error context reports
In-Reply-To: <78188.1720122169@sss.pgh.pa.us>
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
This inbox is served by DDX for PostgreSQL; see mirroring instructions
for how to clone and mirror all data and code used for this inbox