On 1/8/17 11:25 AM, Tom Lane wrote:
But I don't understand
how you got the sample output shown in the patch.  Is this based
on some unsubmitted changes in pltcl's error handling?


AFAICT you've got everything. What I had on my end is:

create function public.tcl_error_handling_test(text)
 returns text
 language pltcl
as $function$
    if {[catch $1 err]} {
                # Set keys that will change over time to fixed values
                array set myArray $::errorCode
                set myArray(funcname) "'funcname'"
                set myArray(lineno) 'lineno'
                set myArray(POSTGRES) 'POSTGRES'

                # Format into something nicer
                set vals []
                foreach {key} [lsort [array names myArray]] {
                        set value [string map {"\n" "\n\t"} $myArray($key)]
                        lappend vals "$key: $value"
                }
                return [join $vals "\n"]
    } else {
        return "no error"
    }
$function$
;

Maybe it's a version difference?

echo 'puts [info patchlevel];exit 0' | tclsh
8.6.6

Anyway, attached is a complete new patch that fixes that issue (and a couple test diffs I missed :/), as well as the utf_e2u issue you discovered. I've applied this patch to master via git apply and run it through make check-world, so hopefully this puts the horse out to pasture.
--
Jim Nasby, Data Architect, Blue Treble Consulting, Austin TX
Experts in Analytics, Data Architecture and PostgreSQL
Data in Trouble? Get it in Treble! http://BlueTreble.com
855-TREBLE2 (855-873-2532)
diff --git a/src/pl/tcl/expected/pltcl_queries.out 
b/src/pl/tcl/expected/pltcl_queries.out
index 3a9fef3447..564ec8a294 100644
--- a/src/pl/tcl/expected/pltcl_queries.out
+++ b/src/pl/tcl/expected/pltcl_queries.out
@@ -1,3 +1,7 @@
+BEGIN;
+SET LOCAL client_min_messages = WARNING;
+CREATE EXTENSION IF NOT EXISTS plpgsql;
+COMMIT;
 -- suppress CONTEXT so that function OIDs aren't in output
 \set VERBOSITY terse
 insert into T_pkey1 values (1, 'key1-1', 'test key');
@@ -185,12 +189,23 @@ select * from T_pkey2 order by key1 using @<, key2 
collate "C";
 
 -- show dump of trigger data
 insert into trigger_test values(1,'insert');
-NOTICE:  NEW: {i: 1, v: insert}
+NOTICE:  NEW: {}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: STATEMENT
+NOTICE:  TG_name: statement_trigger
+NOTICE:  TG_op: INSERT
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {42 {statement trigger}}
+NOTICE:  NEW: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: 
insert}
 NOTICE:  OLD: {}
 NOTICE:  TG_level: ROW
 NOTICE:  TG_name: show_trigger_data_trig
 NOTICE:  TG_op: INSERT
-NOTICE:  TG_relatts: {{} i v}
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
 NOTICE:  TG_relid: bogus:12345
 NOTICE:  TG_table_name: trigger_test
 NOTICE:  TG_table_schema: public
@@ -232,13 +247,37 @@ NOTICE:  TG_table_name: trigger_test_view
 NOTICE:  TG_table_schema: public
 NOTICE:  TG_when: {INSTEAD OF}
 NOTICE:  args: {24 {skidoo view}}
+update trigger_test set v = 'update', test_skip=true where i = 1;
+NOTICE:  NEW: {}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: STATEMENT
+NOTICE:  TG_name: statement_trigger
+NOTICE:  TG_op: UPDATE
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {42 {statement trigger}}
+NOTICE:  SKIPPING OPERATION UPDATE
 update trigger_test set v = 'update' where i = 1;
-NOTICE:  NEW: {i: 1, v: update}
-NOTICE:  OLD: {i: 1, v: insert}
+NOTICE:  NEW: {}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: STATEMENT
+NOTICE:  TG_name: statement_trigger
+NOTICE:  TG_op: UPDATE
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {42 {statement trigger}}
+NOTICE:  NEW: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: 
update}
+NOTICE:  OLD: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: 
insert}
 NOTICE:  TG_level: ROW
 NOTICE:  TG_name: show_trigger_data_trig
 NOTICE:  TG_op: UPDATE
-NOTICE:  TG_relatts: {{} i v}
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
 NOTICE:  TG_relid: bogus:12345
 NOTICE:  TG_table_name: trigger_test
 NOTICE:  TG_table_schema: public
@@ -246,16 +285,39 @@ NOTICE:  TG_when: BEFORE
 NOTICE:  args: {23 skidoo}
 delete from trigger_test;
 NOTICE:  NEW: {}
-NOTICE:  OLD: {i: 1, v: update}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: STATEMENT
+NOTICE:  TG_name: statement_trigger
+NOTICE:  TG_op: DELETE
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {42 {statement trigger}}
+NOTICE:  NEW: {}
+NOTICE:  OLD: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: 
update}
 NOTICE:  TG_level: ROW
 NOTICE:  TG_name: show_trigger_data_trig
 NOTICE:  TG_op: DELETE
-NOTICE:  TG_relatts: {{} i v}
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
 NOTICE:  TG_relid: bogus:12345
 NOTICE:  TG_table_name: trigger_test
 NOTICE:  TG_table_schema: public
 NOTICE:  TG_when: BEFORE
 NOTICE:  args: {23 skidoo}
+truncate trigger_test;
+NOTICE:  NEW: {}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: STATEMENT
+NOTICE:  TG_name: statement_trigger
+NOTICE:  TG_op: TRUNCATE
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {42 {statement trigger}}
 -- Test composite-type arguments
 select tcl_composite_arg_ref1(row('tkey', 42, 'ref2'));
  tcl_composite_arg_ref1 
@@ -288,6 +350,22 @@ select tcl_argisnull(null);
  t
 (1 row)
 
+-- should error
+insert into trigger_test(test_argisnull) values(true);
+NOTICE:  NEW: {}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: STATEMENT
+NOTICE:  TG_name: statement_trigger
+NOTICE:  TG_op: INSERT
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {42 {statement trigger}}
+ERROR:  argisnull cannot be used in triggers
+select trigger_data();
+ERROR:  trigger functions can only be called as triggers
 -- Test spi_lastoid primitive
 create temp table t1 (f1 int);
 select tcl_lastoid('t1');
@@ -304,14 +382,14 @@ select tcl_lastoid('t2') > 0;
 (1 row)
 
 -- test some error cases
-CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl;
-SELECT tcl_error();
+create function tcl_error(out a int, out b int) as $$return {$$ language pltcl;
+select tcl_error();
 ERROR:  missing close-brace
-CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ 
LANGUAGE pltcl;
-SELECT bad_record();
+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
-CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 
cow 3]$$ LANGUAGE pltcl;
-SELECT bad_field();
+create function bad_field(out a text, out b text) as $$return [list a 1 b 2 
cow 3]$$ language pltcl;
+select bad_field();
 ERROR:  column name/value list contains nonexistent column name "cow"
 -- test compound return
 select * from tcl_test_cube_squared(5);
@@ -351,16 +429,243 @@ select 1, tcl_test_sequence(0,5);
         1 |                 4
 (5 rows)
 
-CREATE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl;
+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
-CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS 
$$
+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();
+$$ language pltcl;
+select bad_record_srf();
 ERROR:  column name/value list must have even number of elements
-CREATE FUNCTION bad_field_srf(OUT a text, OUT b text) RETURNS SETOF record AS 
$$
+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();
+$$ language pltcl;
+select bad_field_srf();
 ERROR:  column name/value list contains nonexistent column name "cow"
+-- test quote
+select tcl_eval('quote foo bar');
+ERROR:  wrong # args: should be "quote string"
+select tcl_eval('quote [format %c 39]');
+ tcl_eval 
+----------
+ ''
+(1 row)
+
+select tcl_eval('quote [format %c 92]');
+ tcl_eval 
+----------
+ \\
+(1 row)
+
+-- Test argisnull
+select tcl_eval('argisnull');
+ERROR:  wrong # args: should be "argisnull argno"
+select tcl_eval('argisnull 14');
+ERROR:  argno out of range
+select tcl_eval('argisnull abc');
+ERROR:  expected integer but got "abc"
+-- Test return_null
+select tcl_eval('return_null 14');
+ERROR:  wrong # args: should be "return_null "
+-- should error
+insert into trigger_test(test_return_null) values(true);
+NOTICE:  NEW: {}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: STATEMENT
+NOTICE:  TG_name: statement_trigger
+NOTICE:  TG_op: INSERT
+NOTICE:  TG_relatts: {{} i v {} test_skip test_return_null test_argisnull}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {42 {statement trigger}}
+ERROR:  return_null cannot be used in triggers
+-- Test spi_exec
+select tcl_eval('spi_exec');
+ERROR:  wrong # args: should be "spi_exec ?-count n? ?-array name? query ?loop 
body?"
+select tcl_eval('spi_exec -count');
+ERROR:  missing argument to -count or -array
+select tcl_eval('spi_exec -array');
+ERROR:  missing argument to -count or -array
+select tcl_eval('spi_exec -count abc');
+ERROR:  expected integer but got "abc"
+select tcl_eval('spi_exec query loop body toomuch');
+ERROR:  wrong # args: should be "query ?loop body?"
+select tcl_eval('spi_exec "begin; rollback;"');
+ERROR:  pltcl: SPI_execute failed: SPI_ERROR_TRANSACTION
+-- Test spi_execp
+select tcl_eval('spi_execp');
+ERROR:  missing argument to -count or -array
+select tcl_eval('spi_execp -count');
+ERROR:  missing argument to -array, -count or -nulls
+select tcl_eval('spi_execp -array');
+ERROR:  missing argument to -array, -count or -nulls
+select tcl_eval('spi_execp -count abc');
+ERROR:  expected integer but got "abc"
+select tcl_eval('spi_execp -nulls');
+ERROR:  missing argument to -array, -count or -nulls
+select tcl_eval('spi_execp ""');
+ERROR:  invalid queryid ''
+/*
+ * Verify tcl_error_handling_test() properly reports non-postgres errors. This
+ * may seem silly, but we've had problems with this in the past.
+ */
+select tcl_error_handling_test($tcl$moo$tcl$);
+                  tcl_error_handling_test                   
+------------------------------------------------------------
+ Unexpected error type TCL for error TCL LOOKUP COMMAND moo
+(1 row)
+
+-- test spi_prepare
+select tcl_eval('spi_prepare');
+ERROR:  wrong # args: should be "spi_prepare query argtypes"
+select tcl_eval('spi_prepare a b');
+ERROR:  type "b" does not exist
+select tcl_eval('spi_prepare a "b {"');
+ERROR:  unmatched open brace in list
+select tcl_error_handling_test($tcl$spi_prepare "moo" []$tcl$);
+        tcl_error_handling_test         
+----------------------------------------
+ POSTGRES: 'POSTGRES'                  +
+ SQLSTATE: 42601                       +
+ condition: syntax_error               +
+ cursor_position: 1                    +
+ filename: scan.l                      +
+ funcname: 'funcname'                  +
+ lineno: 'lineno'                      +
+ message: syntax error at or near "moo"+
+ statement: moo
+(1 row)
+
+-- test full error text
+select tcl_error_handling_test($tcl$
+spi_exec "DO $$
+BEGIN
+RAISE 'message'
+       USING HINT = 'hint'
+       , DETAIL = 'detail'
+       , SCHEMA = 'schema'
+       , TABLE = 'table'
+       , COLUMN = 'column'
+       , CONSTRAINT = 'constraint'
+       , DATATYPE = 'datatype'
+;
+END$$;"
+$tcl$);
+                   tcl_error_handling_test                    
+--------------------------------------------------------------
+ POSTGRES: 'POSTGRES'                                        +
+ SQLSTATE: P0001                                             +
+ column: column                                              +
+ condition: raise_exception                                  +
+ constraint: constraint                                      +
+ context: PL/pgSQL function inline_code_block line 3 at RAISE+
+         SQL statement "DO $$                                +
+         BEGIN                                               +
+         RAISE 'message'                                     +
+                 USING HINT = 'hint'                         +
+                 , DETAIL = 'detail'                         +
+                 , SCHEMA = 'schema'                         +
+                 , TABLE = 'table'                           +
+                 , COLUMN = 'column'                         +
+                 , CONSTRAINT = 'constraint'                 +
+                 , DATATYPE = 'datatype'                     +
+         ;                                                   +
+         END$$;"                                             +
+ datatype: datatype                                          +
+ detail: detail                                              +
+ filename: pl_exec.c                                         +
+ funcname: 'funcname'                                        +
+ hint: hint                                                  +
+ lineno: 'lineno'                                            +
+ message: message                                            +
+ schema: schema                                              +
+ table: table
+(1 row)
+
+-- test elog
+select tcl_eval('elog');
+ERROR:  wrong # args: should be "elog level msg"
+select tcl_eval('elog foo bar');
+ERROR:  bad priority "foo": must be DEBUG, LOG, INFO, NOTICE, WARNING, ERROR, 
or FATAL
+-- test forced error
+select tcl_eval('error "forced error"');
+ERROR:  forced error
+select tcl_eval('unset -nocomplain ::tcl_vwait; after 100 {set ::tcl_vwait 1}; 
vwait ::tcl_vwait; unset -nocomplain ::tcl_vwait');
+ tcl_eval 
+----------
+ 
+(1 row)
+
+-- test loop control
+select tcl_spi_exec(true, 'break');
+NOTICE:  attnum 1, attname relname
+NOTICE:  attnum 2, attname relnamespace
+NOTICE:  action: break
+NOTICE:  end of function
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(true, 'continue');
+NOTICE:  attnum 1, attname relname
+NOTICE:  attnum 2, attname relnamespace
+NOTICE:  action: continue
+NOTICE:  attnum 3, attname reltype
+NOTICE:  end of function
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(true, 'error');
+NOTICE:  attnum 1, attname relname
+NOTICE:  attnum 2, attname relnamespace
+NOTICE:  action: error
+ERROR:  error message
+select tcl_spi_exec(true, 'return');
+NOTICE:  attnum 1, attname relname
+NOTICE:  attnum 2, attname relnamespace
+NOTICE:  action: return
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(false, 'break');
+NOTICE:  attnum 1, attname relname
+NOTICE:  attnum 2, attname relnamespace
+NOTICE:  action: break
+NOTICE:  end of function
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(false, 'continue');
+NOTICE:  attnum 1, attname relname
+NOTICE:  attnum 2, attname relnamespace
+NOTICE:  action: continue
+NOTICE:  attnum 3, attname reltype
+NOTICE:  end of function
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(false, 'error');
+NOTICE:  attnum 1, attname relname
+NOTICE:  attnum 2, attname relnamespace
+NOTICE:  action: error
+ERROR:  error message
+select tcl_spi_exec(false, 'return');
+NOTICE:  attnum 1, attname relname
+NOTICE:  attnum 2, attname relnamespace
+NOTICE:  action: return
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
diff --git a/src/pl/tcl/expected/pltcl_setup.out 
b/src/pl/tcl/expected/pltcl_setup.out
index ed99d9b492..5573b14ff0 100644
--- a/src/pl/tcl/expected/pltcl_setup.out
+++ b/src/pl/tcl/expected/pltcl_setup.out
@@ -49,10 +49,31 @@ create function check_pkey1_exists(int4, bpchar) returns 
bool as E'
     return "f"
 ' language pltcl;
 -- dump trigger data
-CREATE TABLE trigger_test
-    (i int, v text );
-CREATE VIEW trigger_test_view AS SELECT * FROM trigger_test;
+CREATE TABLE trigger_test (
+       i int,
+       v text,
+       dropme text,
+       test_skip boolean DEFAULT false,
+       test_return_null boolean DEFAULT false,
+       test_argisnull boolean DEFAULT false
+);
+-- Make certain dropped attributes are handled correctly
+ALTER TABLE trigger_test DROP dropme;
+CREATE VIEW trigger_test_view AS SELECT i, v FROM trigger_test;
 CREATE FUNCTION trigger_data() returns trigger language pltcl as $_$
+       if {$TG_table_name eq "trigger_test" && $TG_level eq "ROW" && $TG_op ne 
"DELETE"} {
+               # Special case tests
+               if {$NEW(test_return_null) eq "t" } {
+                       return_null
+               }
+               if {$NEW(test_argisnull) eq "t" } {
+                       set should_error [argisnull 1]
+               }
+               if {$NEW(test_skip) eq "t" } {
+                       elog NOTICE "SKIPPING OPERATION $TG_op"
+                       return SKIP
+               }
+       }
 
        if { [info exists TG_relid] } {
        set TG_relid "bogus:12345"
@@ -86,6 +107,9 @@ $_$;
 CREATE TRIGGER show_trigger_data_trig
 BEFORE INSERT OR UPDATE OR DELETE ON trigger_test
 FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo');
+CREATE TRIGGER statement_trigger
+BEFORE INSERT OR UPDATE OR DELETE OR TRUNCATE ON trigger_test
+FOR EACH STATEMENT EXECUTE PROCEDURE trigger_data(42,'statement trigger');
 CREATE TRIGGER show_trigger_data_view_trig
 INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view
 FOR EACH ROW EXECUTE PROCEDURE trigger_data(24,'skidoo view');
@@ -555,44 +579,106 @@ NOTICE:  tclsnitch: ddl_command_start DROP TABLE
 NOTICE:  tclsnitch: ddl_command_end DROP TABLE
 drop event trigger tcl_a_snitch;
 drop event trigger tcl_b_snitch;
-CREATE FUNCTION tcl_test_cube_squared(in int, out squared int, out cubed int) 
AS $$
+create function tcl_test_cube_squared(in int, out squared int, out cubed int) 
as $$
     return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
 $$ language pltcl;
-CREATE FUNCTION tcl_test_squared_rows(int,int) RETURNS TABLE (x int, y int) AS 
$$
+create function tcl_test_squared_rows(int,int) returns table (x int, y int) as 
$$
     for {set i $1} {$i < $2} {incr i} {
         return_next [list y [expr {$i * $i}] x $i]
     }
 $$ language pltcl;
-CREATE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$
+create function tcl_test_sequence(int,int) returns setof int as $$
     for {set i $1} {$i < $2} {incr i} {
         return_next $i
     }
 $$ language pltcl;
--- test use of errorCode in error handling
-create function tcl_error_handling_test() returns text as $$
-    global errorCode
-    if {[catch { spi_exec "select no_such_column from foo;" }]} {
-        array set errArray $errorCode
-        if {$errArray(condition) == "undefined_table"} {
-            return "expected error: $errArray(message)"
-        } else {
-            return "unexpected error: $errArray(condition) $errArray(message)"
-        }
+create or replace function tcl_eval(in string varchar) returns text as $$
+       eval $1
+$$ language 'pltcl';
+-- test use of errorcode in error handling
+create function public.tcl_error_handling_test(text)
+ returns text
+ language pltcl
+as $function$
+    if {[catch $1 err]} {
+               if {[lindex $::errorCode 0] != "POSTGRES"} {
+                       return "Unexpected error type [lindex $::errorCode 0] 
for error $::errorCode"
+               }
+
+               # Set keys that will change over time to fixed values
+               array set myArray $::errorCode
+               set myArray(funcname) "'funcname'"
+               set myArray(lineno) 'lineno'
+               set myArray(POSTGRES) 'POSTGRES'
+
+               set vals []
+               # Format into something nicer
+               foreach {key} [lsort [array names myArray]] {
+                       set value [string map {"\n" "\n\t"} $myArray($key)]
+                       lappend vals "$key: $value"
+               }
+               return [join $vals "\n"]
+
     } else {
         return "no error"
     }
-$$ language pltcl;
-select tcl_error_handling_test();
-            tcl_error_handling_test            
------------------------------------------------
- expected error: relation "foo" does not exist
-(1 row)
-
-create temp table foo(f1 int);
-select tcl_error_handling_test();
-                          tcl_error_handling_test                          
----------------------------------------------------------------------------
- unexpected error: undefined_column column "no_such_column" does not exist
-(1 row)
-
-drop table foo;
+$function$
+;
+-- test use of arrays
+create function tcl_spi_exec(
+       prepare boolean,
+       action text
+)
+returns void language pltcl AS $function$
+# unnest would be easier but this way we get multiple fields
+set query "SELECT *
+       FROM pg_attribute
+       WHERE attrelid = 'pg_class'::regclass
+               AND attnum BETWEEN 1 AND 3
+               ORDER BY attnum"
+if {$1 == "t"} {
+       set prep [spi_prepare $query {}]
+       spi_execp -array A $prep {
+               elog NOTICE "attnum $A(attnum), attname $A(attname)"
+
+               switch $A(attnum) {
+                       2 {
+                               elog NOTICE "action: $2"
+                               switch $2 {
+                                       break {
+                                               break
+                                       }
+                                       return {
+                                               return
+                                       }
+                                       error {
+                                               error "error message"
+                                       }
+                               }
+                       }
+               }
+       }
+} else {
+       spi_exec -array A $query {
+               elog NOTICE "attnum $A(attnum), attname $A(attname)"
+
+               switch $A(attnum) {
+                       2 {
+                               elog NOTICE "action: $2"
+                               switch $2 {
+                                       break {
+                                               break
+                                       }
+                                       return {
+                                               return
+                                       }
+                                       error {
+                                               error "error message"
+                                       }
+                               }
+                       }
+               }
+       }
+}
+elog NOTICE "end of function"
+$function$;
diff --git a/src/pl/tcl/sql/pltcl_queries.sql b/src/pl/tcl/sql/pltcl_queries.sql
index 0ebfe65340..24d956c2e7 100644
--- a/src/pl/tcl/sql/pltcl_queries.sql
+++ b/src/pl/tcl/sql/pltcl_queries.sql
@@ -1,3 +1,8 @@
+BEGIN;
+SET LOCAL client_min_messages = WARNING;
+CREATE EXTENSION IF NOT EXISTS plpgsql;
+COMMIT;
+
 -- suppress CONTEXT so that function OIDs aren't in output
 \set VERBOSITY terse
 
@@ -80,8 +85,10 @@ insert into trigger_test_view values(2,'insert');
 update trigger_test_view set v = 'update' where i=1;
 delete from trigger_test_view;
 
+update trigger_test set v = 'update', test_skip=true where i = 1;
 update trigger_test set v = 'update' where i = 1;
 delete from trigger_test;
+truncate trigger_test;
 
 -- Test composite-type arguments
 select tcl_composite_arg_ref1(row('tkey', 42, 'ref2'));
@@ -91,6 +98,9 @@ select tcl_composite_arg_ref2(row('tkey', 42, 'ref2'));
 select tcl_argisnull('foo');
 select tcl_argisnull('');
 select tcl_argisnull(null);
+-- should error
+insert into trigger_test(test_argisnull) values(true);
+select trigger_data();
 
 -- Test spi_lastoid primitive
 create temp table t1 (f1 int);
@@ -99,14 +109,14 @@ create temp table t2 (f1 int) with oids;
 select tcl_lastoid('t2') > 0;
 
 -- test some error cases
-CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl;
-SELECT tcl_error();
+create function tcl_error(out a int, out b int) as $$return {$$ language pltcl;
+select tcl_error();
 
-CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ 
LANGUAGE pltcl;
-SELECT bad_record();
+create function bad_record(out a text, out b text) as $$return [list a]$$ 
language pltcl;
+select bad_record();
 
-CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 
cow 3]$$ LANGUAGE pltcl;
-SELECT bad_field();
+create function bad_field(out a text, out b text) as $$return [list a 1 b 2 
cow 3]$$ language pltcl;
+select bad_field();
 
 -- test compound return
 select * from tcl_test_cube_squared(5);
@@ -118,15 +128,94 @@ select * from tcl_test_sequence(0,5) as a;
 
 select 1, tcl_test_sequence(0,5);
 
-CREATE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl;
+create function non_srf() returns int as $$return_next 1$$ language pltcl;
 select non_srf();
 
-CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS 
$$
+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();
+$$ language pltcl;
+select bad_record_srf();
 
-CREATE FUNCTION bad_field_srf(OUT a text, OUT b text) RETURNS SETOF record AS 
$$
+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();
+$$ language pltcl;
+select bad_field_srf();
+
+-- test quote
+select tcl_eval('quote foo bar');
+select tcl_eval('quote [format %c 39]');
+select tcl_eval('quote [format %c 92]');
+
+-- Test argisnull
+select tcl_eval('argisnull');
+select tcl_eval('argisnull 14');
+select tcl_eval('argisnull abc');
+
+-- Test return_null
+select tcl_eval('return_null 14');
+-- should error
+insert into trigger_test(test_return_null) values(true);
+
+-- Test spi_exec
+select tcl_eval('spi_exec');
+select tcl_eval('spi_exec -count');
+select tcl_eval('spi_exec -array');
+select tcl_eval('spi_exec -count abc');
+select tcl_eval('spi_exec query loop body toomuch');
+select tcl_eval('spi_exec "begin; rollback;"');
+
+-- Test spi_execp
+select tcl_eval('spi_execp');
+select tcl_eval('spi_execp -count');
+select tcl_eval('spi_execp -array');
+select tcl_eval('spi_execp -count abc');
+select tcl_eval('spi_execp -nulls');
+select tcl_eval('spi_execp ""');
+
+/*
+ * Verify tcl_error_handling_test() properly reports non-postgres errors. This
+ * may seem silly, but we've had problems with this in the past.
+ */
+select tcl_error_handling_test($tcl$moo$tcl$);
+
+-- test spi_prepare
+select tcl_eval('spi_prepare');
+select tcl_eval('spi_prepare a b');
+select tcl_eval('spi_prepare a "b {"');
+select tcl_error_handling_test($tcl$spi_prepare "moo" []$tcl$);
+
+-- test full error text
+select tcl_error_handling_test($tcl$
+spi_exec "DO $$
+BEGIN
+RAISE 'message'
+       USING HINT = 'hint'
+       , DETAIL = 'detail'
+       , SCHEMA = 'schema'
+       , TABLE = 'table'
+       , COLUMN = 'column'
+       , CONSTRAINT = 'constraint'
+       , DATATYPE = 'datatype'
+;
+END$$;"
+$tcl$);
+
+
+-- test elog
+select tcl_eval('elog');
+select tcl_eval('elog foo bar');
+
+-- test forced error
+select tcl_eval('error "forced error"');
+
+select tcl_eval('unset -nocomplain ::tcl_vwait; after 100 {set ::tcl_vwait 1}; 
vwait ::tcl_vwait; unset -nocomplain ::tcl_vwait');
+
+-- test loop control
+select tcl_spi_exec(true, 'break');
+select tcl_spi_exec(true, 'continue');
+select tcl_spi_exec(true, 'error');
+select tcl_spi_exec(true, 'return');
+select tcl_spi_exec(false, 'break');
+select tcl_spi_exec(false, 'continue');
+select tcl_spi_exec(false, 'error');
+select tcl_spi_exec(false, 'return');
diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql
index 58f38d53aa..333117629c 100644
--- a/src/pl/tcl/sql/pltcl_setup.sql
+++ b/src/pl/tcl/sql/pltcl_setup.sql
@@ -57,12 +57,33 @@ create function check_pkey1_exists(int4, bpchar) returns 
bool as E'
 
 -- dump trigger data
 
-CREATE TABLE trigger_test
-    (i int, v text );
+CREATE TABLE trigger_test (
+       i int,
+       v text,
+       dropme text,
+       test_skip boolean DEFAULT false,
+       test_return_null boolean DEFAULT false,
+       test_argisnull boolean DEFAULT false
+);
+-- Make certain dropped attributes are handled correctly
+ALTER TABLE trigger_test DROP dropme;
 
-CREATE VIEW trigger_test_view AS SELECT * FROM trigger_test;
+CREATE VIEW trigger_test_view AS SELECT i, v FROM trigger_test;
 
 CREATE FUNCTION trigger_data() returns trigger language pltcl as $_$
+       if {$TG_table_name eq "trigger_test" && $TG_level eq "ROW" && $TG_op ne 
"DELETE"} {
+               # Special case tests
+               if {$NEW(test_return_null) eq "t" } {
+                       return_null
+               }
+               if {$NEW(test_argisnull) eq "t" } {
+                       set should_error [argisnull 1]
+               }
+               if {$NEW(test_skip) eq "t" } {
+                       elog NOTICE "SKIPPING OPERATION $TG_op"
+                       return SKIP
+               }
+       }
 
        if { [info exists TG_relid] } {
        set TG_relid "bogus:12345"
@@ -97,6 +118,9 @@ $_$;
 CREATE TRIGGER show_trigger_data_trig
 BEFORE INSERT OR UPDATE OR DELETE ON trigger_test
 FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo');
+CREATE TRIGGER statement_trigger
+BEFORE INSERT OR UPDATE OR DELETE OR TRUNCATE ON trigger_test
+FOR EACH STATEMENT EXECUTE PROCEDURE trigger_data(42,'statement trigger');
 
 CREATE TRIGGER show_trigger_data_view_trig
 INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view
@@ -596,42 +620,113 @@ drop table foo;
 drop event trigger tcl_a_snitch;
 drop event trigger tcl_b_snitch;
 
-CREATE FUNCTION tcl_test_cube_squared(in int, out squared int, out cubed int) 
AS $$
+create function tcl_test_cube_squared(in int, out squared int, out cubed int) 
as $$
     return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
 $$ language pltcl;
 
-CREATE FUNCTION tcl_test_squared_rows(int,int) RETURNS TABLE (x int, y int) AS 
$$
+create function tcl_test_squared_rows(int,int) returns table (x int, y int) as 
$$
     for {set i $1} {$i < $2} {incr i} {
         return_next [list y [expr {$i * $i}] x $i]
     }
 $$ language pltcl;
 
-CREATE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$
+create function tcl_test_sequence(int,int) returns setof int as $$
     for {set i $1} {$i < $2} {incr i} {
         return_next $i
     }
 $$ language pltcl;
 
--- test use of errorCode in error handling
+create or replace function tcl_eval(in string varchar) returns text as $$
+       eval $1
+$$ language 'pltcl';
 
-create function tcl_error_handling_test() returns text as $$
-    global errorCode
-    if {[catch { spi_exec "select no_such_column from foo;" }]} {
-        array set errArray $errorCode
-        if {$errArray(condition) == "undefined_table"} {
-            return "expected error: $errArray(message)"
-        } else {
-            return "unexpected error: $errArray(condition) $errArray(message)"
-        }
-    } else {
-        return "no error"
-    }
-$$ language pltcl;
 
-select tcl_error_handling_test();
+-- test use of errorcode in error handling
 
-create temp table foo(f1 int);
+create function public.tcl_error_handling_test(text)
+ returns text
+ language pltcl
+as $function$
+    if {[catch $1 err]} {
+               if {[lindex $::errorCode 0] != "POSTGRES"} {
+                       return "Unexpected error type [lindex $::errorCode 0] 
for error $::errorCode"
+               }
 
-select tcl_error_handling_test();
+               # Set keys that will change over time to fixed values
+               array set myArray $::errorCode
+               set myArray(funcname) "'funcname'"
+               set myArray(lineno) 'lineno'
+               set myArray(POSTGRES) 'POSTGRES'
+
+               set vals []
+               # Format into something nicer
+               foreach {key} [lsort [array names myArray]] {
+                       set value [string map {"\n" "\n\t"} $myArray($key)]
+                       lappend vals "$key: $value"
+               }
+               return [join $vals "\n"]
 
-drop table foo;
+    } else {
+        return "no error"
+    }
+$function$
+;
+
+-- test use of arrays
+create function tcl_spi_exec(
+       prepare boolean,
+       action text
+)
+returns void language pltcl AS $function$
+# unnest would be easier but this way we get multiple fields
+set query "SELECT *
+       FROM pg_attribute
+       WHERE attrelid = 'pg_class'::regclass
+               AND attnum BETWEEN 1 AND 3
+               ORDER BY attnum"
+if {$1 == "t"} {
+       set prep [spi_prepare $query {}]
+       spi_execp -array A $prep {
+               elog NOTICE "attnum $A(attnum), attname $A(attname)"
+
+               switch $A(attnum) {
+                       2 {
+                               elog NOTICE "action: $2"
+                               switch $2 {
+                                       break {
+                                               break
+                                       }
+                                       return {
+                                               return
+                                       }
+                                       error {
+                                               error "error message"
+                                       }
+                               }
+                       }
+               }
+       }
+} else {
+       spi_exec -array A $query {
+               elog NOTICE "attnum $A(attnum), attname $A(attname)"
+
+               switch $A(attnum) {
+                       2 {
+                               elog NOTICE "action: $2"
+                               switch $2 {
+                                       break {
+                                               break
+                                       }
+                                       return {
+                                               return
+                                       }
+                                       error {
+                                               error "error message"
+                                       }
+                               }
+                       }
+               }
+       }
+}
+elog NOTICE "end of function"
+$function$;
-- 
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers

Reply via email to