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

From Tom Lane
Subject Improving PL/Tcl's error context reports
Date
Msg-id 890581.1717609350@sss.pgh.pa.us
Whole thread Raw
List pgsql-hackers
While working on commit b631d0149, I got a bee in my bonnet about
how unfriendly PL/Tcl's error CONTEXT reports are:

* The context reports expose PL/Tcl's internal names for the Tcl
procedures it creates, which'd be fine if those names were readable.
But actually they're something like "__PLTcl_proc_NNNN", where NNNN
is the function OID.  Not only is that unintelligible, but because
the OIDs aren't stable this forces us to disable display of the
CONTEXT lines in all of PL/Tcl's regression tests.

* The first line of the context report (almost?) always duplicates
the primary error message, which is redundant and not per our
normal reporting style.

So attached is a patch that attempts to improve this situation.

The key question is how to avoid including function OIDs in the
strings that will appear in the regression test outputs.  The
answer I propose is to start with an internal name like
"__PLTcl_proc_NAME", where NAME is the function's normal SQL name,
and then append the OID only if that function name is not unique.
As long as we don't create test cases that involve throwing
errors from duplicatively-named functions, we can show the context
reports and still have stable regression outputs.  I think this will
improve the user experience for regular users too.

PL/Tcl wants the internal names to be all-ASCII-alphanumeric,
which saves it from having to think about encoding conversion
or quoting when inserting those names into Tcl command strings.
What I did in the attached is to copy only ASCII alphanumerics
from the SQL name.  Perhaps it's worth working harder but
I failed to get excited about that.

A few notes:

* To avoid unnecessarily appending the OID when a function is
redefined, I modified the logic to explicitly delete the old Tcl
command before checking for duplication.  This is okay even if the
function is currently being evaluated, because Tcl's internal
reference counting prevents it from deleting the underlying code
object until it's done being executed.  Really we were depending on
that reference counting to handle such cases already, but you wouldn't
have known it from our comments.  I added a test case to demonstrate
explicitly that this works correctly.

* Sadly, pltcl_trigger.sql still has to suppress the context
reports.  Although its function names are now stable, the reports
include trigger argument lists, which include numeric table OIDs
so they're unstable.  I don't see a way to change that without
breaking API for user trigger functions.

* A hazard with this plan is that the regression tests' context
reports might turn out to be platform-dependent.  I experimented
with Tcl 8.5 and 8.6 here and found one difference: the "missing
close-brace" error reported by our tcl_error() test case shows the
unmatched open-brace on one version but not the other.  AFAICS the
point of that test is just to exercise some Tcl-detected error, not
necessarily that exact one, so I just modified the test case to cause
a different error.  We might find additional problems once this patch
hits the buildfarm or gets out into the field.

I'll park this in the next CF.


            regards, tom lane

diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index b31f2c1330..64c4918419 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/doc/src/sgml/pltcl.sgml
@@ -1120,16 +1120,24 @@ 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 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..27a3d355c6 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {quote foo bar}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval argisnull"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {argisnull 14}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {argisnull abc}"
+in PL/Tcl function "tcl_eval"
 -- 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {return_null 14}"
+in PL/Tcl function "tcl_eval"
 -- 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval spi_exec"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_exec -count}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_exec -array}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_exec -count abc}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_exec query loop body toomuch}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_exec "begin; rollback;"}"
+in PL/Tcl function "tcl_eval"
 -- 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval spi_execp"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_execp -count}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_execp -array}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_execp -count abc}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_execp -nulls}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_execp ""}"
+in PL/Tcl function "tcl_eval"
 -- 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval spi_prepare"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {spi_prepare a b}"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval spi_prepare\ a\ \"b\ \{\""
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval elog"
+in PL/Tcl function "tcl_eval"
 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {elog foo bar}"
+in PL/Tcl function "tcl_eval"
 -- 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" line 3)
+    invoked from within
+"__PLTcl_proc_tcl_eval {error "forced error"}"
+in PL/Tcl function "tcl_eval"
 -- 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" line 6)
+    invoked from within
+"__PLTcl_proc_tcl_spi_exec t error"
+in PL/Tcl function "tcl_spi_exec"
 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" line 31)
+    invoked from within
+"__PLTcl_proc_tcl_spi_exec f error"
+in PL/Tcl function "tcl_spi_exec"
 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..b21850fbbd 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..5b62fb770c 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -124,11 +124,13 @@ 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.
@@ -136,7 +138,7 @@ typedef struct pltcl_interp_desc
 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       *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,9 +1377,24 @@ 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++;
+
     ereport(ERROR,
             (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
              errmsg("%s", emsg),
@@ -1405,6 +1422,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 +1453,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 +1471,85 @@ 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 *internal_proname;
         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 internal proc name from the function's name 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.  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 function's SQL name */
+        for (const char *ptr = NameStr(procStruct->proname); *ptr; ptr++)
+        {
+            if (strchr("ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                       "abcdefghijklmnopqrstuvwxyz"
+                       "0123456789_", *ptr) != NULL)
+                Tcl_DStringAppend(&proc_internal_name, ptr, 1);
+        }
+        /* 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.
@@ -1513,13 +1581,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 +1775,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 +1804,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

 --

pgsql-hackers by date:

Previous
From: Matthias van de Meent
Date:
Subject: Re: use CREATE DATABASE STRATEGY = FILE_COPY in pg_upgrade
Next
From: Nathan Bossart
Date:
Subject: Re: use CREATE DATABASE STRATEGY = FILE_COPY in pg_upgrade