Re: Improving PL/Tcl's error context reports - Mailing list pgsql-hackers

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

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();

     <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.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 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.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 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.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 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.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_transaction.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_trigger.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

 --