Adding upstream version 13.4.upstream/13.4upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

8 files changed, 1922 insertions, 0 deletions

diff --git a/src/pl/tcl/expected/pltcl_call.out b/src/pl/tcl/expected/pltcl_call.out
new file mode 100644
index 0000000..d290c8f
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_call.out
@@ -0,0 +1,55 @@
+CREATE PROCEDURE test_proc1()
+LANGUAGE pltcl
+AS $$
+unset
+$$;
+CALL test_proc1();
+CREATE PROCEDURE test_proc2()
+LANGUAGE pltcl
+AS $$
+return 5
+$$;
+CALL test_proc2();
+CREATE TABLE test1 (a int);
+CREATE PROCEDURE test_proc3(x int)
+LANGUAGE pltcl
+AS $$
+spi_exec "INSERT INTO test1 VALUES ($1)"
+$$;
+CALL test_proc3(55);
+SELECT * FROM test1;
+ a  
+----
+ 55
+(1 row)
+
+-- output arguments
+CREATE PROCEDURE test_proc5(INOUT a text)
+LANGUAGE pltcl
+AS $$
+set aa [concat $1 "+" $1]
+return [list a $aa]
+$$;
+CALL test_proc5('abc');
+     a     
+-----------
+ abc + abc
+(1 row)
+
+CREATE PROCEDURE test_proc6(a int, INOUT b int, INOUT c int)
+LANGUAGE pltcl
+AS $$
+set bb [expr $2 * $1]
+set cc [expr $3 * $1]
+return [list b $bb c $cc]
+$$;
+CALL test_proc6(2, 3, 4);
+ b | c 
+---+---
+ 6 | 8
+(1 row)
+
+DROP PROCEDURE test_proc1;
+DROP PROCEDURE test_proc2;
+DROP PROCEDURE test_proc3;
+DROP TABLE test1;
diff --git a/src/pl/tcl/expected/pltcl_queries.out b/src/pl/tcl/expected/pltcl_queries.out
new file mode 100644
index 0000000..2d922c2
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_queries.out
@@ -0,0 +1,397 @@
+-- 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 
+------------------------
+                     42
+(1 row)
+
+select tcl_composite_arg_ref2(row('tkey', 42, 'ref2'));
+ tcl_composite_arg_ref2 
+------------------------
+ ref2                
+(1 row)
+
+-- More tests for composite argument/result types
+create domain d_comp1 as T_comp1 check ((value).ref1 > 0);
+create function tcl_record_arg(record, fldname text) returns int as '
+    return $1($2)
+' language pltcl;
+select tcl_record_arg(row('tkey', 42, 'ref2')::T_comp1, 'ref1');
+ tcl_record_arg 
+----------------
+             42
+(1 row)
+
+select tcl_record_arg(row('tkey', 42, 'ref2')::d_comp1, 'ref1');
+ tcl_record_arg 
+----------------
+             42
+(1 row)
+
+select tcl_record_arg(row(2,4), 'f2');
+ tcl_record_arg 
+----------------
+              4
+(1 row)
+
+create function tcl_cdomain_arg(d_comp1) returns int as '
+    return $1(ref1)
+' language pltcl;
+select tcl_cdomain_arg(row('tkey', 42, 'ref2'));
+ tcl_cdomain_arg 
+-----------------
+              42
+(1 row)
+
+select tcl_cdomain_arg(row('tkey', 42, 'ref2')::T_comp1);
+ tcl_cdomain_arg 
+-----------------
+              42
+(1 row)
+
+select tcl_cdomain_arg(row('tkey', -1, 'ref2'));  -- fail
+ERROR:  value for domain d_comp1 violates check constraint "d_comp1_check"
+-- Test argisnull primitive
+select tcl_argisnull('foo');
+ tcl_argisnull 
+---------------
+ f
+(1 row)
+
+select tcl_argisnull('');
+ tcl_argisnull 
+---------------
+ f
+(1 row)
+
+select tcl_argisnull(null);
+ tcl_argisnull 
+---------------
+ t
+(1 row)
+
+-- test some error cases
+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();
+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();
+ERROR:  column name/value list contains nonexistent column name "cow"
+-- test compound return
+select * from tcl_test_cube_squared(5);
+ squared | cubed 
+---------+-------
+      25 |   125
+(1 row)
+
+-- test SRF
+select * from tcl_test_squared_rows(0,5);
+ x | y  
+---+----
+ 0 |  0
+ 1 |  1
+ 2 |  4
+ 3 |  9
+ 4 | 16
+(5 rows)
+
+select * from tcl_test_sequence(0,5) as a;
+ a 
+---
+ 0
+ 1
+ 2
+ 3
+ 4
+(5 rows)
+
+select 1, tcl_test_sequence(0,5);
+ ?column? | tcl_test_sequence 
+----------+-------------------
+        1 |                 0
+        1 |                 1
+        1 |                 2
+        1 |                 3
+        1 |                 4
+(5 rows)
+
+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 $$
+return_next [list a]
+$$ 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 $$
+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"
+-- 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]
+$$ language pltcl;
+select tcl_composite_result(1001);
+            tcl_composite_result            
+--------------------------------------------
+ ("tkey1     ",1001,"ref22               ")
+(1 row)
+
+select * from tcl_composite_result(1002);
+    tkey    | ref1 |         ref2         
+------------+------+----------------------
+ tkey1      | 1002 | ref22               
+(1 row)
+
+create function tcl_dcomposite_result(int) returns d_comp1 as $$
+return [list tkey tkey2 ref1 $1 ref2 ref42]
+$$ language pltcl;
+select tcl_dcomposite_result(1001);
+           tcl_dcomposite_result            
+--------------------------------------------
+ ("tkey2     ",1001,"ref42               ")
+(1 row)
+
+select * from tcl_dcomposite_result(1002);
+    tkey    | ref1 |         ref2         
+------------+------+----------------------
+ tkey2      | 1002 | ref42               
+(1 row)
+
+select * from tcl_dcomposite_result(-1);  -- fail
+ERROR:  value for domain d_comp1 violates check constraint "d_comp1_check"
+create function tcl_record_result(int) returns record as $$
+return [list q1 sometext q2 $1 q3 moretext]
+$$ 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
+select * from tcl_record_result(42) as (q1 text, q2 int, q3 text);
+    q1    | q2 |    q3    
+----------+----+----------
+ sometext | 42 | moretext
+(1 row)
+
+select * from tcl_record_result(42) as (q1 text, q2 int, q3 text, q4 int);
+    q1    | q2 |    q3    | q4 
+----------+----+----------+----
+ sometext | 42 | moretext |   
+(1 row)
+
+select * from tcl_record_result(42) as (q1 text, q2 int, q4 int);  -- fail
+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"
+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 "
+-- 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 ''
+-- 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 "select moo" []$tcl$);
+       tcl_error_handling_test        
+--------------------------------------
+ SQLSTATE: 42703                     +
+ condition: undefined_column         +
+ cursor_position: 8                  +
+ message: column "moo" does not exist+
+ statement: select moo
+(1 row)
+
+-- test full error text
+select tcl_error_handling_test($tcl$
+spi_exec "DO $$
+BEGIN
+RAISE 'my message'
+	USING HINT = 'my hint'
+	, DETAIL = 'my detail'
+	, SCHEMA = 'my schema'
+	, TABLE = 'my table'
+	, COLUMN = 'my column'
+	, CONSTRAINT = 'my constraint'
+	, DATATYPE = 'my datatype'
+;
+END$$;"
+$tcl$);
+                   tcl_error_handling_test                    
+--------------------------------------------------------------
+ SQLSTATE: P0001                                             +
+ column: my column                                           +
+ condition: raise_exception                                  +
+ constraint: my constraint                                   +
+ context: PL/pgSQL function inline_code_block line 3 at RAISE+
+         SQL statement "DO $$                                +
+         BEGIN                                               +
+         RAISE 'my message'                                  +
+                 USING HINT = 'my hint'                      +
+                 , DETAIL = 'my detail'                      +
+                 , SCHEMA = 'my schema'                      +
+                 , TABLE = 'my table'                        +
+                 , COLUMN = 'my column'                      +
+                 , CONSTRAINT = 'my constraint'              +
+                 , DATATYPE = 'my datatype'                  +
+         ;                                                   +
+         END$$;"                                             +
+ datatype: my datatype                                       +
+ detail: my detail                                           +
+ hint: my hint                                               +
+ message: my message                                         +
+ schema: my schema                                           +
+ table: my table
+(1 row)
+
+-- verify tcl_error_handling_test() properly reports non-postgres errors
+select tcl_error_handling_test('moo');
+  tcl_error_handling_test   
+----------------------------
+ invalid command name "moo"
+(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
+-- test loop control in spi_exec[p]
+select tcl_spi_exec(true, 'break');
+NOTICE:  col1 1, col2 foo
+NOTICE:  col1 2, col2 bar
+NOTICE:  action: break
+NOTICE:  end of function
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(true, 'continue');
+NOTICE:  col1 1, col2 foo
+NOTICE:  col1 2, col2 bar
+NOTICE:  action: continue
+NOTICE:  col1 3, col2 baz
+NOTICE:  end of function
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(true, 'error');
+NOTICE:  col1 1, col2 foo
+NOTICE:  col1 2, col2 bar
+NOTICE:  action: error
+ERROR:  error message
+select tcl_spi_exec(true, 'return');
+NOTICE:  col1 1, col2 foo
+NOTICE:  col1 2, col2 bar
+NOTICE:  action: return
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(false, 'break');
+NOTICE:  col1 1, col2 foo
+NOTICE:  col1 2, col2 bar
+NOTICE:  action: break
+NOTICE:  end of function
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(false, 'continue');
+NOTICE:  col1 1, col2 foo
+NOTICE:  col1 2, col2 bar
+NOTICE:  action: continue
+NOTICE:  col1 3, col2 baz
+NOTICE:  end of function
+ tcl_spi_exec 
+--------------
+ 
+(1 row)
+
+select tcl_spi_exec(false, 'error');
+NOTICE:  col1 1, col2 foo
+NOTICE:  col1 2, col2 bar
+NOTICE:  action: error
+ERROR:  error message
+select tcl_spi_exec(false, 'return');
+NOTICE:  col1 1, col2 foo
+NOTICE:  col1 2, col2 bar
+NOTICE:  action: return
+ tcl_spi_exec 
+--------------
+ 
+(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($$
+  unset -nocomplain ::tcl_vwait
+  after 100 {set ::tcl_vwait 1}
+  vwait ::tcl_vwait
+  unset -nocomplain ::tcl_vwait$$);
+ tcl_eval 
+----------
+ 
+(1 row)
+
diff --git a/src/pl/tcl/expected/pltcl_setup.out b/src/pl/tcl/expected/pltcl_setup.out
new file mode 100644
index 0000000..ed809f0
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_setup.out
@@ -0,0 +1,263 @@
+create table T_comp1 (
+    tkey	char(10),
+    ref1	int4,
+    ref2	char(20)
+);
+create function tcl_composite_arg_ref1(T_comp1) returns int as '
+    return $1(ref1)
+' language pltcl;
+create function tcl_composite_arg_ref2(T_comp1) returns text as '
+    return $1(ref2)
+' language pltcl;
+create function tcl_argisnull(text) returns bool as '
+    argisnull 1
+' language pltcl;
+create function tcl_int4add(int4,int4) returns int4 as '
+    return [expr $1 + $2]
+' language pltcl;
+-- We use split(n) as a quick-and-dirty way of parsing the input array
+-- value, which comes in as a string like '{1,2}'.  There are better ways...
+create function tcl_int4_accum(int4[], int4) returns int4[] as '
+    set state [split $1 "{,}"]
+    set newsum [expr {[lindex $state 1] + $2}]
+    set newcnt [expr {[lindex $state 2] + 1}]
+    return "{$newsum,$newcnt}"
+' language pltcl;
+create function tcl_int4_avg(int4[]) returns int4 as '
+    set state [split $1 "{,}"]
+    if {[lindex $state 2] == 0} { return_null }
+    return [expr {[lindex $state 1] / [lindex $state 2]}]
+' language pltcl;
+create aggregate tcl_avg (
+		sfunc = tcl_int4_accum,
+		basetype = int4,
+		stype = int4[],
+		finalfunc = tcl_int4_avg,
+		initcond = '{0,0}'
+	);
+create aggregate tcl_sum (
+		sfunc = tcl_int4add,
+		basetype = int4,
+		stype = int4,
+		initcond1 = 0
+	);
+create function tcl_int4lt(int4,int4) returns bool as '
+    if {$1 < $2} {
+        return t
+    }
+    return f
+' language pltcl;
+create function tcl_int4le(int4,int4) returns bool as '
+    if {$1 <= $2} {
+        return t
+    }
+    return f
+' language pltcl;
+create function tcl_int4eq(int4,int4) returns bool as '
+    if {$1 == $2} {
+        return t
+    }
+    return f
+' language pltcl;
+create function tcl_int4ge(int4,int4) returns bool as '
+    if {$1 >= $2} {
+        return t
+    }
+    return f
+' language pltcl;
+create function tcl_int4gt(int4,int4) returns bool as '
+    if {$1 > $2} {
+        return t
+    }
+    return f
+' language pltcl;
+create operator @< (
+		leftarg = int4,
+		rightarg = int4,
+		procedure = tcl_int4lt
+	);
+create operator @<= (
+		leftarg = int4,
+		rightarg = int4,
+		procedure = tcl_int4le
+	);
+create operator @= (
+		leftarg = int4,
+		rightarg = int4,
+		procedure = tcl_int4eq
+	);
+create operator @>= (
+		leftarg = int4,
+		rightarg = int4,
+		procedure = tcl_int4ge
+	);
+create operator @> (
+		leftarg = int4,
+		rightarg = int4,
+		procedure = tcl_int4gt
+	);
+create function tcl_int4cmp(int4,int4) returns int4 as '
+    if {$1 < $2} {
+        return -1
+    }
+    if {$1 > $2} {
+        return 1
+    }
+    return 0
+' language pltcl;
+CREATE OPERATOR CLASS tcl_int4_ops
+	FOR TYPE int4 USING btree AS
+	OPERATOR 1  @<,
+	OPERATOR 2  @<=,
+	OPERATOR 3  @=,
+	OPERATOR 4  @>=,
+	OPERATOR 5  @>,
+	FUNCTION 1  tcl_int4cmp(int4,int4) ;
+--
+-- Test usage of Tcl's "clock" command.  In recent Tcl versions this
+-- command fails without working "unknown" support, so it's a good canary
+-- for initialization problems.
+--
+create function tcl_date_week(int4,int4,int4) returns text as $$
+    return [clock format [clock scan "$2/$3/$1"] -format "%U"]
+$$ language pltcl immutable;
+select tcl_date_week(2010,1,26);
+ tcl_date_week 
+---------------
+ 04
+(1 row)
+
+select tcl_date_week(2001,10,24);
+ tcl_date_week 
+---------------
+ 42
+(1 row)
+
+-- test pltcl event triggers
+create function tclsnitch() returns event_trigger language pltcl as $$
+  elog NOTICE "tclsnitch: $TG_event $TG_tag"
+$$;
+create event trigger tcl_a_snitch on ddl_command_start execute procedure tclsnitch();
+create event trigger tcl_b_snitch on ddl_command_end execute procedure tclsnitch();
+create function foobar() returns int language sql as $$select 1;$$;
+NOTICE:  tclsnitch: ddl_command_start CREATE FUNCTION
+NOTICE:  tclsnitch: ddl_command_end CREATE FUNCTION
+alter function foobar() cost 77;
+NOTICE:  tclsnitch: ddl_command_start ALTER FUNCTION
+NOTICE:  tclsnitch: ddl_command_end ALTER FUNCTION
+drop function foobar();
+NOTICE:  tclsnitch: ddl_command_start DROP FUNCTION
+NOTICE:  tclsnitch: ddl_command_end DROP FUNCTION
+create table foo();
+NOTICE:  tclsnitch: ddl_command_start CREATE TABLE
+NOTICE:  tclsnitch: ddl_command_end CREATE TABLE
+drop table foo;
+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 $$
+    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 $$
+    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 $$
+    for {set i $1} {$i < $2} {incr i} {
+        return_next $i
+    }
+$$ language pltcl;
+create function tcl_eval(string text) returns text as $$
+    eval $1
+$$ language pltcl;
+-- test use of errorCode in error handling
+create function tcl_error_handling_test(text) returns text
+language pltcl
+as $function$
+    if {[catch $1 err]} {
+        # If not a Postgres error, just return the basic error message
+        if {[lindex $::errorCode 0] != "POSTGRES"} {
+            return $err
+        }
+
+        # Get rid of keys that can't be expected to remain constant
+        array set myArray $::errorCode
+        unset myArray(POSTGRES)
+        unset -nocomplain myArray(funcname)
+        unset -nocomplain myArray(filename)
+        unset -nocomplain myArray(lineno)
+
+        # 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$;
+-- test spi_exec and spi_execp with -array
+create function tcl_spi_exec(
+    prepare boolean,
+    action text
+)
+returns void language pltcl AS $function$
+set query "select * from (values (1,'foo'),(2,'bar'),(3,'baz')) v(col1,col2)"
+if {$1 == "t"} {
+    set prep [spi_prepare $query {}]
+    spi_execp -array A $prep {
+        elog NOTICE "col1 $A(col1), col2 $A(col2)"
+
+        switch $A(col1) {
+            2 {
+                elog NOTICE "action: $2"
+                switch $2 {
+                    break {
+                        break
+                    }
+                    continue {
+                        continue
+                    }
+                    return {
+                        return
+                    }
+                    error {
+                        error "error message"
+                    }
+                }
+                error "should not get here"
+            }
+        }
+    }
+} else {
+    spi_exec -array A $query {
+        elog NOTICE "col1 $A(col1), col2 $A(col2)"
+
+        switch $A(col1) {
+            2 {
+                elog NOTICE "action: $2"
+                switch $2 {
+                    break {
+                        break
+                    }
+                    continue {
+                        continue
+                    }
+                    return {
+                        return
+                    }
+                    error {
+                        error "error message"
+                    }
+                }
+                error "should not get here"
+            }
+        }
+    }
+}
+elog NOTICE "end of function"
+$function$;
diff --git a/src/pl/tcl/expected/pltcl_start_proc.out b/src/pl/tcl/expected/pltcl_start_proc.out
new file mode 100644
index 0000000..9946cd9
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_start_proc.out
@@ -0,0 +1,31 @@
+--
+-- Test start_proc execution
+--
+SET pltcl.start_proc = 'no_such_function';
+select tcl_int4add(1, 2);
+ERROR:  function no_such_function() does not exist
+CONTEXT:  processing pltcl.start_proc parameter
+select tcl_int4add(1, 2);
+ERROR:  function no_such_function() does not exist
+CONTEXT:  processing pltcl.start_proc parameter
+create function tcl_initialize() returns void as
+$$ elog NOTICE "in tcl_initialize" $$ language pltcl SECURITY DEFINER;
+SET pltcl.start_proc = 'public.tcl_initialize';
+select tcl_int4add(1, 2);  -- fail
+ERROR:  function "public.tcl_initialize" must not be SECURITY DEFINER
+CONTEXT:  processing pltcl.start_proc parameter
+create or replace function tcl_initialize() returns void as
+$$ elog NOTICE "in tcl_initialize" $$ language pltcl;
+select tcl_int4add(1, 2);
+NOTICE:  in tcl_initialize
+ tcl_int4add 
+-------------
+           3
+(1 row)
+
+select tcl_int4add(1, 2);
+ tcl_int4add 
+-------------
+           3
+(1 row)
+
diff --git a/src/pl/tcl/expected/pltcl_subxact.out b/src/pl/tcl/expected/pltcl_subxact.out
new file mode 100644
index 0000000..5e19bbb
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_subxact.out
@@ -0,0 +1,143 @@
+--
+-- Test explicit subtransactions
+--
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+--
+-- We use this wrapper to catch errors and return errormsg only,
+-- because values of $::errorinfo variable contain procedure name which
+-- includes OID, so it's not stable
+--
+CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text
+AS $$
+    if [catch {spi_exec $1} msg] {
+        return "ERROR: $msg"
+    } else {
+        return "SUCCESS: $msg"
+    }
+$$ LANGUAGE pltcl;
+-- Test subtransaction successfully committed
+CREATE FUNCTION subtransaction_ctx_success() RETURNS void
+AS $$
+    spi_exec "INSERT INTO subtransaction_tbl VALUES(1)"
+    subtransaction {
+        spi_exec "INSERT INTO subtransaction_tbl VALUES(2)"
+    }
+$$ LANGUAGE pltcl;
+BEGIN;
+INSERT INTO subtransaction_tbl VALUES(0);
+SELECT subtransaction_ctx_success();
+ subtransaction_ctx_success 
+----------------------------
+ 
+(1 row)
+
+COMMIT;
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 0
+ 1
+ 2
+(3 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Test subtransaction rollback
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS void
+AS $$
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    subtransaction {
+        spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+        if {$1 == "SPI"} {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')"
+        } elseif { $1 == "Tcl"} {
+            elog ERROR "Tcl error"
+        }
+    }
+$$ LANGUAGE pltcl;
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test()');
+ pltcl_wrapper 
+---------------
+ SUCCESS: 1
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 1
+ 2
+(2 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''SPI'')');
+                    pltcl_wrapper                     
+------------------------------------------------------
+ ERROR: invalid input syntax for type integer: "oops"
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''Tcl'')');
+  pltcl_wrapper   
+------------------
+ ERROR: Tcl error
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Nested subtransactions
+CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text
+AS $$
+spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if [catch {
+        subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+        }
+    } errormsg] {
+        if {$1 != "t"} {
+            error $errormsg $::errorInfo $::errorCode
+        }
+        elog NOTICE "Swallowed $errormsg"
+    }
+}
+return "ok"
+$$ LANGUAGE pltcl;
+SELECT pltcl_wrapper('SELECT subtransaction_nested_test()');
+             pltcl_wrapper              
+----------------------------------------
+ ERROR: syntax error at or near "error"
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_nested_test(''t'')');
+NOTICE:  Swallowed syntax error at or near "error"
+ pltcl_wrapper 
+---------------
+ SUCCESS: 1
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 1
+ 2
+(2 rows)
+
+TRUNCATE subtransaction_tbl;
diff --git a/src/pl/tcl/expected/pltcl_transaction.out b/src/pl/tcl/expected/pltcl_transaction.out
new file mode 100644
index 0000000..007204b
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_transaction.out
@@ -0,0 +1,100 @@
+-- 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
+AS $$
+for {set i 0} {$i < 10} {incr i} {
+    spi_exec "INSERT INTO test1 (a) VALUES ($i)"
+    if {$i % 2 == 0} {
+        commit
+    } else {
+        rollback
+    }
+}
+$$;
+CALL transaction_test1();
+SELECT * FROM test1;
+ a | b 
+---+---
+ 0 | 
+ 2 | 
+ 4 | 
+ 6 | 
+ 8 | 
+(5 rows)
+
+TRUNCATE test1;
+-- not allowed in a function
+CREATE FUNCTION transaction_test2() RETURNS int
+LANGUAGE pltcl
+AS $$
+for {set i 0} {$i < 10} {incr i} {
+    spi_exec "INSERT INTO test1 (a) VALUES ($i)"
+    if {$i % 2 == 0} {
+        commit
+    } else {
+        rollback
+    }
+}
+return 1
+$$;
+SELECT transaction_test2();
+ERROR:  invalid transaction termination
+SELECT * FROM test1;
+ a | b 
+---+---
+(0 rows)
+
+-- also not allowed if procedure is called from a function
+CREATE FUNCTION transaction_test3() RETURNS int
+LANGUAGE pltcl
+AS $$
+spi_exec "CALL transaction_test1()"
+return 1
+$$;
+SELECT transaction_test3();
+ERROR:  invalid transaction termination
+SELECT * FROM test1;
+ a | b 
+---+---
+(0 rows)
+
+-- commit inside cursor loop
+CREATE TABLE test2 (x int);
+INSERT INTO test2 VALUES (0), (1), (2), (3), (4);
+TRUNCATE test1;
+CREATE PROCEDURE transaction_test4a()
+LANGUAGE pltcl
+AS $$
+spi_exec -array row "SELECT * FROM test2 ORDER BY x" {
+    spi_exec "INSERT INTO test1 (a) VALUES ($row(x))"
+    commit
+}
+$$;
+CALL transaction_test4a();
+ERROR:  cannot commit while a subtransaction is active
+SELECT * FROM test1;
+ a | b 
+---+---
+(0 rows)
+
+-- rollback inside cursor loop
+TRUNCATE test1;
+CREATE PROCEDURE transaction_test4b()
+LANGUAGE pltcl
+AS $$
+spi_exec -array row "SELECT * FROM test2 ORDER BY x" {
+    spi_exec "INSERT INTO test1 (a) VALUES ($row(x))"
+    rollback
+}
+$$;
+CALL transaction_test4b();
+ERROR:  cannot roll back while a subtransaction is active
+SELECT * FROM test1;
+ a | b 
+---+---
+(0 rows)
+
+DROP TABLE test1;
+DROP TABLE test2;
diff --git a/src/pl/tcl/expected/pltcl_trigger.out b/src/pl/tcl/expected/pltcl_trigger.out
new file mode 100644
index 0000000..008ea19
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_trigger.out
@@ -0,0 +1,888 @@
+-- suppress CONTEXT so that function OIDs aren't in output
+\set VERBOSITY terse
+--
+-- Create the tables used in the test queries
+--
+-- T_pkey1 is the primary key table for T_dta1. Entries from T_pkey1
+-- Cannot be changed or deleted if they are referenced from T_dta1.
+--
+-- T_pkey2 is the primary key table for T_dta2. If the key values in
+-- T_pkey2 are changed, the references in T_dta2 follow. If entries
+-- are deleted, the referencing entries from T_dta2 are deleted too.
+-- The values for field key2 in T_pkey2 are silently converted to
+-- upper case on insert/update.
+--
+create table T_pkey1 (
+    key1	int4,
+    key2	char(20),
+    txt		char(40)
+);
+create table T_pkey2 (
+    key1	int4,
+    key2	char(20),
+    txt		char(40)
+);
+create table T_dta1 (
+    tkey	char(10),
+    ref1	int4,
+    ref2	char(20)
+);
+create table T_dta2 (
+    tkey	char(10),
+    ref1	int4,
+    ref2	char(20)
+);
+--
+-- Function to check key existence in T_pkey1
+--
+create function check_pkey1_exists(int4, bpchar) returns bool as E'
+    if {![info exists GD]} {
+        set GD(plan) [spi_prepare				\\
+	    "select 1 from T_pkey1				\\
+	        where key1 = \\$1 and key2 = \\$2"		\\
+	    {int4 bpchar}]
+    }
+
+    set n [spi_execp -count 1 $GD(plan) [list $1 $2]]
+
+    if {$n > 0} {
+        return "t"
+    }
+    return "f"
+' language pltcl;
+-- dump trigger data
+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 TABLE trigger_test_generated (
+   i int,
+   j int GENERATED ALWAYS AS (i * 2) STORED
+);
+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"
+	}
+
+	set dnames [info locals {[a-zA-Z]*} ]
+
+	foreach key [lsort $dnames] {
+
+		if { [array exists $key] } {
+			set str "{"
+			foreach akey [lsort [ array names $key ] ] {
+				if {[string length $str] > 1} { set str "$str, " }
+				set cmd "($akey)"
+				set cmd "set val \$$key$cmd"
+				eval $cmd
+				set str "$str$akey: $val"
+			}
+			set str "$str}"
+		elog NOTICE "$key: $str"
+		} else {
+			set val [eval list "\$$key" ]
+		elog NOTICE "$key: $val"
+		}
+	}
+
+
+	return OK
+
+$_$;
+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_trig_before
+BEFORE INSERT OR UPDATE OR DELETE ON trigger_test_generated
+FOR EACH ROW EXECUTE PROCEDURE trigger_data();
+CREATE TRIGGER show_trigger_data_trig_after
+AFTER INSERT OR UPDATE OR DELETE ON trigger_test_generated
+FOR EACH ROW EXECUTE PROCEDURE trigger_data();
+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');
+--
+-- Trigger function on every change to T_pkey1
+--
+create function trig_pkey1_before() returns trigger as E'
+    #
+    # Create prepared plans on the first call
+    #
+    if {![info exists GD]} {
+	#
+	# Plan to check for duplicate key in T_pkey1
+	#
+        set GD(plan_pkey1) [spi_prepare				\\
+	    "select check_pkey1_exists(\\$1, \\$2) as ret"	\\
+	    {int4 bpchar}]
+	#
+	# Plan to check for references from T_dta1
+	#
+        set GD(plan_dta1) [spi_prepare				\\
+	    "select 1 from T_dta1				\\
+	        where ref1 = \\$1 and ref2 = \\$2"		\\
+	    {int4 bpchar}]
+    }
+
+    #
+    # Initialize flags
+    #
+    set check_old_ref 0
+    set check_new_dup 0
+
+    switch $TG_op {
+        INSERT {
+	    #
+	    # Must check for duplicate key on INSERT
+	    #
+	    set check_new_dup 1
+	}
+	UPDATE {
+	    #
+	    # Must check for duplicate key on UPDATE only if
+	    # the key changes. In that case we must check for
+	    # references to OLD values too.
+	    #
+	    if {[string compare $NEW(key1) $OLD(key1)] != 0} {
+	        set check_old_ref 1
+		set check_new_dup 1
+	    }
+	    if {[string compare $NEW(key2) $OLD(key2)] != 0} {
+	        set check_old_ref 1
+		set check_new_dup 1
+	    }
+	}
+	DELETE {
+	    #
+	    # Must only check for references to OLD on DELETE
+	    #
+	    set check_old_ref 1
+	}
+    }
+
+    if {$check_new_dup} {
+	#
+	# Check for duplicate key
+	#
+        spi_execp -count 1 $GD(plan_pkey1) [list $NEW(key1) $NEW(key2)]
+	if {$ret == "t"} {
+	    elog ERROR \\
+	        "duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey1"
+	}
+    }
+
+    if {$check_old_ref} {
+	#
+	# Check for references to OLD
+	#
+        set n [spi_execp -count 1 $GD(plan_dta1) [list $OLD(key1) $OLD(key2)]]
+	if {$n > 0} {
+	    elog ERROR \\
+	        "key ''$OLD(key1)'', ''$OLD(key2)'' referenced by T_dta1"
+	}
+    }
+
+    #
+    # Anything is fine - let operation pass through
+    #
+    return OK
+' language pltcl;
+create trigger pkey1_before before insert or update or delete on T_pkey1
+	for each row execute procedure
+	trig_pkey1_before();
+--
+-- Trigger function to check for duplicate keys in T_pkey2
+-- and to force key2 to be upper case only without leading whitespaces
+--
+create function trig_pkey2_before() returns trigger as E'
+    #
+    # Prepare plan on first call
+    #
+    if {![info exists GD]} {
+        set GD(plan_pkey2) [spi_prepare				\\
+	    "select 1 from T_pkey2				\\
+	        where key1 = \\$1 and key2 = \\$2"		\\
+	    {int4 bpchar}]
+    }
+
+    #
+    # Convert key2 value
+    #
+    set NEW(key2) [string toupper [string trim $NEW(key2)]]
+
+    #
+    # Check for duplicate key
+    #
+    set n [spi_execp -count 1 $GD(plan_pkey2) [list $NEW(key1) $NEW(key2)]]
+    if {$n > 0} {
+	elog ERROR \\
+	    "duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey2"
+    }
+
+    #
+    # Return modified tuple in NEW
+    #
+    return [array get NEW]
+' language pltcl;
+create trigger pkey2_before before insert or update on T_pkey2
+	for each row execute procedure
+	trig_pkey2_before();
+--
+-- Trigger function to force references from T_dta2 follow changes
+-- in T_pkey2 or be deleted too. This must be done AFTER the changes
+-- in T_pkey2 are done so the trigger for primkey check on T_dta2
+-- fired on our updates will see the new key values in T_pkey2.
+--
+create function trig_pkey2_after() returns trigger as E'
+    #
+    # Prepare plans on first call
+    #
+    if {![info exists GD]} {
+	#
+	# Plan to update references from T_dta2
+	#
+        set GD(plan_dta2_upd) [spi_prepare			\\
+	    "update T_dta2 set ref1 = \\$3, ref2 = \\$4		\\
+	        where ref1 = \\$1 and ref2 = \\$2"		\\
+	    {int4 bpchar int4 bpchar}]
+	#
+	# Plan to delete references from T_dta2
+	#
+        set GD(plan_dta2_del) [spi_prepare			\\
+	    "delete from T_dta2 				\\
+	        where ref1 = \\$1 and ref2 = \\$2"		\\
+	    {int4 bpchar}]
+    }
+
+    #
+    # Initialize flags
+    #
+    set old_ref_follow 0
+    set old_ref_delete 0
+
+    switch $TG_op {
+	UPDATE {
+	    #
+	    # On update we must let old references follow
+	    #
+	    set NEW(key2) [string toupper $NEW(key2)]
+
+	    if {[string compare $NEW(key1) $OLD(key1)] != 0} {
+	        set old_ref_follow 1
+	    }
+	    if {[string compare $NEW(key2) $OLD(key2)] != 0} {
+	        set old_ref_follow 1
+	    }
+	}
+	DELETE {
+	    #
+	    # On delete we must delete references too
+	    #
+	    set old_ref_delete 1
+	}
+    }
+
+    if {$old_ref_follow} {
+	#
+	# Let old references follow and fire NOTICE message if
+	# there where some
+	#
+        set n [spi_execp $GD(plan_dta2_upd) \\
+	    [list $OLD(key1) $OLD(key2) $NEW(key1) $NEW(key2)]]
+	if {$n > 0} {
+	    elog NOTICE \\
+		"updated $n entries in T_dta2 for new key in T_pkey2"
+        }
+    }
+
+    if {$old_ref_delete} {
+	#
+	# delete references and fire NOTICE message if
+	# there where some
+	#
+        set n [spi_execp $GD(plan_dta2_del) \\
+	    [list $OLD(key1) $OLD(key2)]]
+	if {$n > 0} {
+	    elog NOTICE \\
+		"deleted $n entries from T_dta2"
+        }
+    }
+
+    return OK
+' language pltcl;
+create trigger pkey2_after after update or delete on T_pkey2
+	for each row execute procedure
+	trig_pkey2_after();
+--
+-- Generic trigger function to check references in T_dta1 and T_dta2
+--
+create function check_primkey() returns trigger as E'
+    #
+    # For every trigger/relation pair we create
+    # a saved plan and hold them in GD
+    #
+    set plankey [list "plan" $TG_name $TG_relid]
+    set planrel [list "relname" $TG_relid]
+
+    #
+    # Extract the pkey relation name
+    #
+    set keyidx [expr [llength $args] / 2]
+    set keyrel [string tolower [lindex $args $keyidx]]
+
+    if {![info exists GD($plankey)]} {
+	#
+	# We must prepare a new plan. Build up a query string
+	# for the primary key check.
+	#
+	set keylist [lrange $args [expr $keyidx + 1] end]
+
+        set query "select 1 from $keyrel"
+	set qual " where"
+	set typlist ""
+	set idx 1
+	foreach key $keylist {
+	    set key [string tolower $key]
+	    #
+	    # Add the qual part to the query string
+	    #
+	    append query "$qual $key = \\$$idx"
+	    set qual " and"
+
+	    #
+	    # Lookup the fields type in pg_attribute
+	    #
+	    set n [spi_exec "select T.typname			\\
+	        from pg_catalog.pg_type T, pg_catalog.pg_attribute A, pg_catalog.pg_class C	\\
+		where C.relname  = ''[quote $keyrel]''		\\
+		  and C.oid      = A.attrelid			\\
+		  and A.attname  = ''[quote $key]''		\\
+		  and A.atttypid = T.oid"]
+	    if {$n != 1} {
+	        elog ERROR "table $keyrel doesn''t have a field named $key"
+	    }
+
+	    #
+	    # Append the fields type to the argument type list
+	    #
+	    lappend typlist $typname
+	    incr idx
+	}
+
+	#
+	# Prepare the plan
+	#
+	set GD($plankey) [spi_prepare $query $typlist]
+
+	#
+	# Lookup and remember the table name for later error messages
+	#
+	spi_exec "select relname from pg_catalog.pg_class	\\
+		where oid = ''$TG_relid''::oid"
+	set GD($planrel) $relname
+    }
+
+    #
+    # Build the argument list from the NEW row
+    #
+    incr keyidx -1
+    set arglist ""
+    foreach arg [lrange $args 0 $keyidx] {
+        lappend arglist $NEW($arg)
+    }
+
+    #
+    # Check for the primary key
+    #
+    set n [spi_execp -count 1 $GD($plankey) $arglist]
+    if {$n <= 0} {
+        elog ERROR "key for $GD($planrel) not in $keyrel"
+    }
+
+    #
+    # Anything is fine
+    #
+    return OK
+' language pltcl;
+create trigger dta1_before before insert or update on T_dta1
+	for each row execute procedure
+	check_primkey('ref1', 'ref2', 'T_pkey1', 'key1', 'key2');
+create trigger dta2_before before insert or update on T_dta2
+	for each row execute procedure
+	check_primkey('ref1', 'ref2', 'T_pkey2', 'key1', 'key2');
+insert into T_pkey1 values (1, 'key1-1', 'test key');
+insert into T_pkey1 values (1, 'key1-2', 'test key');
+insert into T_pkey1 values (1, 'key1-3', 'test key');
+insert into T_pkey1 values (2, 'key2-1', 'test key');
+insert into T_pkey1 values (2, 'key2-2', 'test key');
+insert into T_pkey1 values (2, 'key2-3', 'test key');
+insert into T_pkey2 values (1, 'key1-1', 'test key');
+insert into T_pkey2 values (1, 'key1-2', 'test key');
+insert into T_pkey2 values (1, 'key1-3', 'test key');
+insert into T_pkey2 values (2, 'key2-1', 'test key');
+insert into T_pkey2 values (2, 'key2-2', 'test key');
+insert into T_pkey2 values (2, 'key2-3', 'test key');
+select * from T_pkey1;
+ key1 |         key2         |                   txt                    
+------+----------------------+------------------------------------------
+    1 | key1-1               | test key                                
+    1 | key1-2               | test key                                
+    1 | key1-3               | test key                                
+    2 | key2-1               | test key                                
+    2 | key2-2               | test key                                
+    2 | key2-3               | test key                                
+(6 rows)
+
+-- key2 in T_pkey2 should have upper case only
+select * from T_pkey2;
+ key1 |         key2         |                   txt                    
+------+----------------------+------------------------------------------
+    1 | KEY1-1               | test key                                
+    1 | KEY1-2               | test key                                
+    1 | KEY1-3               | test key                                
+    2 | KEY2-1               | test key                                
+    2 | KEY2-2               | test key                                
+    2 | KEY2-3               | test key                                
+(6 rows)
+
+insert into T_pkey1 values (1, 'KEY1-3', 'should work');
+-- Due to the upper case translation in trigger this must fail
+insert into T_pkey2 values (1, 'KEY1-3', 'should fail');
+ERROR:  duplicate key '1', 'KEY1-3' for T_pkey2
+insert into T_dta1 values ('trec 1', 1, 'key1-1');
+insert into T_dta1 values ('trec 2', 1, 'key1-2');
+insert into T_dta1 values ('trec 3', 1, 'key1-3');
+-- Must fail due to unknown key in T_pkey1
+insert into T_dta1 values ('trec 4', 1, 'key1-4');
+ERROR:  key for t_dta1 not in t_pkey1
+insert into T_dta2 values ('trec 1', 1, 'KEY1-1');
+insert into T_dta2 values ('trec 2', 1, 'KEY1-2');
+insert into T_dta2 values ('trec 3', 1, 'KEY1-3');
+-- Must fail due to unknown key in T_pkey2
+insert into T_dta2 values ('trec 4', 1, 'KEY1-4');
+ERROR:  key for t_dta2 not in t_pkey2
+select * from T_dta1;
+    tkey    | ref1 |         ref2         
+------------+------+----------------------
+ trec 1     |    1 | key1-1              
+ trec 2     |    1 | key1-2              
+ trec 3     |    1 | key1-3              
+(3 rows)
+
+select * from T_dta2;
+    tkey    | ref1 |         ref2         
+------------+------+----------------------
+ trec 1     |    1 | KEY1-1              
+ trec 2     |    1 | KEY1-2              
+ trec 3     |    1 | KEY1-3              
+(3 rows)
+
+update T_pkey1 set key2 = 'key2-9' where key1 = 2 and key2 = 'key2-1';
+update T_pkey1 set key2 = 'key1-9' where key1 = 1 and key2 = 'key1-1';
+ERROR:  key '1', 'key1-1              ' referenced by T_dta1
+delete from T_pkey1 where key1 = 2 and key2 = 'key2-2';
+delete from T_pkey1 where key1 = 1 and key2 = 'key1-2';
+ERROR:  key '1', 'key1-2              ' referenced by T_dta1
+update T_pkey2 set key2 = 'KEY2-9' where key1 = 2 and key2 = 'KEY2-1';
+update T_pkey2 set key2 = 'KEY1-9' where key1 = 1 and key2 = 'KEY1-1';
+NOTICE:  updated 1 entries in T_dta2 for new key in T_pkey2
+delete from T_pkey2 where key1 = 2 and key2 = 'KEY2-2';
+delete from T_pkey2 where key1 = 1 and key2 = 'KEY1-2';
+NOTICE:  deleted 1 entries from T_dta2
+select * from T_pkey1;
+ key1 |         key2         |                   txt                    
+------+----------------------+------------------------------------------
+    1 | key1-1               | test key                                
+    1 | key1-2               | test key                                
+    1 | key1-3               | test key                                
+    2 | key2-3               | test key                                
+    1 | KEY1-3               | should work                             
+    2 | key2-9               | test key                                
+(6 rows)
+
+select * from T_pkey2;
+ key1 |         key2         |                   txt                    
+------+----------------------+------------------------------------------
+    1 | KEY1-3               | test key                                
+    2 | KEY2-3               | test key                                
+    2 | KEY2-9               | test key                                
+    1 | KEY1-9               | test key                                
+(4 rows)
+
+select * from T_dta1;
+    tkey    | ref1 |         ref2         
+------------+------+----------------------
+ trec 1     |    1 | key1-1              
+ trec 2     |    1 | key1-2              
+ trec 3     |    1 | key1-3              
+(3 rows)
+
+select * from T_dta2;
+    tkey    | ref1 |         ref2         
+------------+------+----------------------
+ trec 3     |    1 | KEY1-3              
+ trec 1     |    1 | KEY1-9              
+(2 rows)
+
+select tcl_avg(key1) from T_pkey1;
+ tcl_avg 
+---------
+       1
+(1 row)
+
+select tcl_sum(key1) from T_pkey1;
+ tcl_sum 
+---------
+       8
+(1 row)
+
+select tcl_avg(key1) from T_pkey2;
+ tcl_avg 
+---------
+       1
+(1 row)
+
+select tcl_sum(key1) from T_pkey2;
+ tcl_sum 
+---------
+       6
+(1 row)
+
+-- The following should return NULL instead of 0
+select tcl_avg(key1) from T_pkey1 where key1 = 99;
+ tcl_avg 
+---------
+        
+(1 row)
+
+select tcl_sum(key1) from T_pkey1 where key1 = 99;
+ tcl_sum 
+---------
+       0
+(1 row)
+
+select 1 @< 2;
+ ?column? 
+----------
+ t
+(1 row)
+
+select 100 @< 4;
+ ?column? 
+----------
+ f
+(1 row)
+
+select * from T_pkey1 order by key1 using @<, key2 collate "C";
+ key1 |         key2         |                   txt                    
+------+----------------------+------------------------------------------
+    1 | KEY1-3               | should work                             
+    1 | key1-1               | test key                                
+    1 | key1-2               | test key                                
+    1 | key1-3               | test key                                
+    2 | key2-3               | test key                                
+    2 | key2-9               | test key                                
+(6 rows)
+
+select * from T_pkey2 order by key1 using @<, key2 collate "C";
+ key1 |         key2         |                   txt                    
+------+----------------------+------------------------------------------
+    1 | KEY1-3               | test key                                
+    1 | KEY1-9               | test key                                
+    2 | KEY2-3               | test key                                
+    2 | KEY2-9               | test key                                
+(4 rows)
+
+-- show dump of trigger data
+insert into trigger_test values(1,'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 {} 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}
+insert into trigger_test_generated (i) values (1);
+NOTICE:  NEW: {i: 1}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_trig_before
+NOTICE:  TG_op: INSERT
+NOTICE:  TG_relatts: {{} i j}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test_generated
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {}
+NOTICE:  NEW: {i: 1, j: 2}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_trig_after
+NOTICE:  TG_op: INSERT
+NOTICE:  TG_relatts: {{} i j}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test_generated
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: AFTER
+NOTICE:  args: {}
+update trigger_test_generated set i = 11 where i = 1;
+NOTICE:  NEW: {i: 11}
+NOTICE:  OLD: {i: 1, j: 2}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_trig_before
+NOTICE:  TG_op: UPDATE
+NOTICE:  TG_relatts: {{} i j}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test_generated
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {}
+NOTICE:  NEW: {i: 11, j: 22}
+NOTICE:  OLD: {i: 1, j: 2}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_trig_after
+NOTICE:  TG_op: UPDATE
+NOTICE:  TG_relatts: {{} i j}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test_generated
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: AFTER
+NOTICE:  args: {}
+delete from trigger_test_generated;
+NOTICE:  NEW: {}
+NOTICE:  OLD: {i: 11, j: 22}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_trig_before
+NOTICE:  TG_op: DELETE
+NOTICE:  TG_relatts: {{} i j}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test_generated
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: BEFORE
+NOTICE:  args: {}
+NOTICE:  NEW: {}
+NOTICE:  OLD: {i: 11, j: 22}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_trig_after
+NOTICE:  TG_op: DELETE
+NOTICE:  TG_relatts: {{} i j}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test_generated
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: AFTER
+NOTICE:  args: {}
+insert into trigger_test_view values(2,'insert');
+NOTICE:  NEW: {i: 2, v: insert}
+NOTICE:  OLD: {}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_view_trig
+NOTICE:  TG_op: INSERT
+NOTICE:  TG_relatts: {{} i v}
+NOTICE:  TG_relid: bogus:12345
+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_view set v = 'update' where i=1;
+NOTICE:  NEW: {i: 1, v: update}
+NOTICE:  OLD: {i: 1, v: insert}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_view_trig
+NOTICE:  TG_op: UPDATE
+NOTICE:  TG_relatts: {{} i v}
+NOTICE:  TG_relid: bogus:12345
+NOTICE:  TG_table_name: trigger_test_view
+NOTICE:  TG_table_schema: public
+NOTICE:  TG_when: {INSTEAD OF}
+NOTICE:  args: {24 {skidoo view}}
+delete from trigger_test_view;
+NOTICE:  NEW: {}
+NOTICE:  OLD: {i: 1, v: insert}
+NOTICE:  TG_level: ROW
+NOTICE:  TG_name: show_trigger_data_view_trig
+NOTICE:  TG_op: DELETE
+NOTICE:  TG_relatts: {{} i v}
+NOTICE:  TG_relid: bogus:12345
+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: {}
+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 {} 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}
+delete from trigger_test;
+NOTICE:  NEW: {}
+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 {} 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}}
+DROP TRIGGER show_trigger_data_trig_before ON trigger_test_generated;
+DROP TRIGGER show_trigger_data_trig_after ON trigger_test_generated;
+-- 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
+-- 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 transition table visibility
+create table transition_table_test (id int, name text);
+insert into transition_table_test values (1, 'a');
+create function transition_table_test_f() returns trigger language pltcl as
+$$
+  spi_exec -array C "SELECT id, name FROM old_table" {
+    elog INFO "old: $C(id) -> $C(name)"
+  }
+  spi_exec -array C "SELECT id, name FROM new_table" {
+    elog INFO "new: $C(id) -> $C(name)"
+  }
+  return OK
+$$;
+CREATE TRIGGER a_t AFTER UPDATE ON transition_table_test
+  REFERENCING OLD TABLE AS old_table NEW TABLE AS new_table
+  FOR EACH STATEMENT EXECUTE PROCEDURE transition_table_test_f();
+update transition_table_test set name = 'b';
+INFO:  old: 1 -> a
+INFO:  new: 1 -> b
+drop table transition_table_test;
+drop function transition_table_test_f();
+-- dealing with generated columns
+CREATE FUNCTION generated_test_func1() RETURNS trigger
+LANGUAGE pltcl
+AS $$
+# not allowed
+set NEW(j) 5
+return [array get NEW]
+$$;
+CREATE TRIGGER generated_test_trigger1 BEFORE INSERT ON trigger_test_generated
+FOR EACH ROW EXECUTE PROCEDURE generated_test_func1();
+TRUNCATE trigger_test_generated;
+INSERT INTO trigger_test_generated (i) VALUES (1);
+ERROR:  cannot set generated column "j"
+SELECT * FROM trigger_test_generated;
+ i | j 
+---+---
+(0 rows)
+
diff --git a/src/pl/tcl/expected/pltcl_unicode.out b/src/pl/tcl/expected/pltcl_unicode.out
new file mode 100644
index 0000000..eea7d70
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_unicode.out
@@ -0,0 +1,45 @@
+--
+-- Unicode handling
+--
+-- Note: this test case is known to fail if the database encoding is
+-- EUC_CN, EUC_JP, EUC_KR, or EUC_TW, for lack of any equivalent to
+-- U+00A0 (no-break space) in those encodings.  However, testing with
+-- plain ASCII data would be rather useless, so we must live with that.
+--
+SET client_encoding TO UTF8;
+CREATE TABLE unicode_test (
+    testvalue  text NOT NULL
+);
+CREATE FUNCTION unicode_return() RETURNS text AS $$
+  return "\xA0"
+$$ LANGUAGE pltcl;
+CREATE FUNCTION unicode_trigger() RETURNS trigger AS $$
+  set NEW(testvalue) "\xA0"
+  return [array get NEW]
+$$ LANGUAGE pltcl;
+CREATE TRIGGER unicode_test_bi BEFORE INSERT ON unicode_test
+  FOR EACH ROW EXECUTE PROCEDURE unicode_trigger();
+CREATE FUNCTION unicode_plan1() RETURNS text AS $$
+  set plan [ spi_prepare {SELECT $1 AS testvalue} [ list "text" ] ]
+  spi_execp $plan [ list "\xA0" ]
+  return $testvalue
+$$ LANGUAGE pltcl;
+SELECT unicode_return();
+ unicode_return 
+----------------
+  
+(1 row)
+
+INSERT INTO unicode_test (testvalue) VALUES ('test');
+SELECT * FROM unicode_test;
+ testvalue 
+-----------
+  
+(1 row)
+
+SELECT unicode_plan1();
+ unicode_plan1 
+---------------
+  
+(1 row)
+