Support PL/Tcl functions that return composite types and/or sets.

Jim Nasby, rather heavily editorialized by me

Patch: <f2134651-14b3-efeb-f274-c69f3c084031@BlueTreble.com>

doc/src/sgml/pltcl.sgml

@@ -94,11 +94,11 @@ $$ LANGUAGE pltcl;
 
     <para>
      The body of the function is simply a piece of Tcl script.
-     When the function is called, the argument values are passed as
-     variables <literal>$1</literal> ... <literal>$<replaceable>n</replaceable></literal> to the
-     Tcl script.  The result is returned
-     from the Tcl code in the usual way, with a <literal>return</literal>
-     statement.
+     When the function is called, the argument values are passed to the
+     Tcl script as variables named <literal>1</literal>
+     ... <literal><replaceable>n</replaceable></literal>.  The result is
+     returned from the Tcl code in the usual way, with
+     a <literal>return</literal> statement.
     </para>
 
     <para>
@@ -173,17 +173,57 @@ $$ LANGUAGE pltcl;
     </para>
 
     <para>
-     There is currently no support for returning a composite-type
-     result value, nor for returning sets.
+     PL/Tcl functions can return composite-type results, too.  To do this,
+     the Tcl code must return a list of column name/value pairs matching
+     the expected result type.  Any column names omitted from the list
+     are returned as nulls, and an error is raised if there are unexpected
+     column names.  Here is an example:
+
+<programlisting>
+CREATE FUNCTION square_cube(in int, out squared int, out cubed int) AS $$
+    return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
+$$ LANGUAGE pltcl;
+</programlisting>
     </para>
 
+    <tip>
+     <para>
+      The result list can be made from an array representation of the
+      desired tuple with the <literal>array get</> Tcl command.  For example:
+
+<programlisting>
+CREATE FUNCTION raise_pay(employee, delta int) RETURNS employee AS $$
+    set 1(salary) [expr {$1(salary) + $2}]
+    return [array get 1]
+$$ LANGUAGE pltcl;
+</programlisting>
+     </para>
+    </tip>
+
     <para>
-     <application>PL/Tcl</> does not currently have full support for
-     domain types: it treats a domain the same as the underlying scalar
-     type.  This means that constraints associated with the domain will
-     not be enforced.  This is not an issue for function arguments, but
-     it is a hazard if you declare a <application>PL/Tcl</> function
-     as returning a domain type.
+     PL/Tcl functions can return sets.  To do this, the Tcl code should
+     call <function>return_next</function> once per row to be returned,
+     passing either the appropriate value when returning a scalar type,
+     or a list of column name/value pairs when returning a composite type.
+     Here is an example returning a scalar type:
+
+<programlisting>
+CREATE FUNCTION sequence(int, int) RETURNS SETOF int AS $$
+    for {set i $1} {$i &lt; $2} {incr i} {
+        return_next $i
+    }
+$$ LANGUAGE pltcl;
+</programlisting>
+
+     and here is one returning a composite type:
+
+<programlisting>
+CREATE FUNCTION table_of_squares(int, int) RETURNS TABLE (x int, x2 int) AS $$
+    for {set i $1} {$i &lt; $2} {incr i} {
+        return_next [list x $i x2 [expr {$i * $i}]]
+    }
+$$ LANGUAGE pltcl;
+</programlisting>
     </para>
 
    </sect1>
@@ -195,10 +235,9 @@ $$ LANGUAGE pltcl;
      The argument values supplied to a PL/Tcl function's code are simply
      the input arguments converted to text form (just as if they had been
      displayed by a <command>SELECT</> statement).  Conversely, the
-     <literal>return</>
-     command will accept any string that is acceptable input format for
-     the function's declared return type.  So, within the PL/Tcl function,
-     all values are just text strings.
+     <literal>return</> and <literal>return_next</> commands will accept
+     any string that is acceptable input format for the function's declared
+     result type, or for the specified column of a composite result type.
     </para>
 
    </sect1>

src/pl/tcl/expected/pltcl_queries.out

@@ -303,3 +303,64 @@ select tcl_lastoid('t2') > 0;
  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"

src/pl/tcl/expected/pltcl_setup.out

@@ -555,6 +555,19 @@ 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;
 -- test use of errorCode in error handling
 create function tcl_error_handling_test() returns text as $$
     global errorCode

src/pl/tcl/sql/pltcl_queries.sql

@@ -97,3 +97,36 @@ create temp table t1 (f1 int);
 select tcl_lastoid('t1');
 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 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();
+
+-- test compound return
+select * from tcl_test_cube_squared(5);
+
+-- test SRF
+select * from tcl_test_squared_rows(0,5);
+
+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;
+select non_srf();
+
+CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$
+return_next [list a]
+$$ LANGUAGE pltcl;
+SELECT bad_record_srf();
+
+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();

src/pl/tcl/sql/pltcl_setup.sql

@@ -596,6 +596,22 @@ 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;
+
 -- test use of errorCode in error handling
 
 create function tcl_error_handling_test() returns text as $$