text: 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);
  select tcl_date_week(2001,10,24);
  
  -- 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;$$;
  alter function foobar() cost 77;
  drop function foobar();
  
  create table foo();
  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 $$
      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$;
  