Written forms for generic subroutines.

git-svn-id: https://xlr.svn.sourceforge.net/svnroot/xlr/trunk@220 ed21b5e9-bf16-0410-b9ea-f1dd0686f206

xl2/native/TESTS/08.Aggregates/for_loops.ref

@@ -13,3 +13,58 @@ I=4 and J=4
 I=5 and J=2
 I=5 and J=3
 I=5 and J=4
+Entering For loop, It=30
+TeaForTwo I=30
+End of for loop, It=30
+TeaForTwo I=31
+End of for loop, It=31
+TeaForTwo I=32
+End of for loop, It=32
+TeaForTwo I=33
+End of for loop, It=33
+TeaForTwo I=34
+End of for loop, It=34
+TeaForTwo I=35
+End of for loop, It=35
+TeaForTwo I=36
+End of for loop, It=36
+TeaForTwo I=37
+End of for loop, It=37
+TeaForTwo I=38
+End of for loop, It=38
+TeaForTwo I=39
+End of for loop, It=39
+TeaForTwo I=40
+End of for loop, It=40
+TeaForTwo I=41
+End of for loop, It=41
+TeaForTwo I=42
+End of for loop, It=42
+TeaForTwo I=43
+End of for loop, It=43
+TeaForTwo I=44
+End of for loop, It=44
+TeaForTwo I=45
+End of for loop, It=45
+TeaForTwo I=46
+End of for loop, It=46
+TeaForTwo I=47
+End of for loop, It=47
+TeaForTwo I=48
+End of for loop, It=48
+TeaForTwo I=49
+End of for loop, It=49
+TeaForTwo I=50
+End of for loop, It=50
+Exited for loop, It=51
+Bye Bye!
+BeeBopBelula I=51
+BeeBopBelula I=53
+BeeBopBelula I=55
+BeeBopBelula I=57
+BeeBopBelula I=59
+BeeBopBelula I=61
+BeeBopBelula I=63
+BeeBopBelula I=65
+BeeBopBelula I=67
+BeeBopBelula I=69

xl2/native/TESTS/10.Generics/generic_written.ref

@@ -0,0 +1 @@
+GenericAssign called

xl2/native/TESTS/10.Generics/generic_written.xl

@@ -0,0 +1,14 @@
+// This tests that generic subroutines can have written forms
+// (It doesn't work yet)
+use XL.UI.CONSOLE
+
+generic [type item]
+procedure GenericAssign(out X: item; Y : item) written X := Y is
+    WriteLn "GenericAssign called"
+
+type zebulon is record with
+    X : integer
+    Y : real
+
+Z : zebulon
+U : zebulon := Z

xl2/native/TESTS/10.Generics/minimax_vararg_generic_mismatch.ref

@@ -0,0 +1,9 @@
+10.Generics/minimax_vararg_generic_mismatch.xl:17: Errors while instantiating 'Max':
+| Test_bad     : integer := Max(1, 2.5)
+|_____________________________^
+10.Generics/minimax_vararg_generic_mismatch.xl:17: with '...' set to '2.5'
+| Test_bad     : integer := Max(1, 2.5)
+|____________________________________^
+10.Generics/minimax_vararg_generic_mismatch.xl:12: No translation found for 'result := Max ( ... )'
+|     result := Max(...)
+|_____________^

xl2/native/TESTS/10.Generics/minimax_vararg_generic_mismatch.xl

@@ -0,0 +1,17 @@
+// Checks that we detect and report type mismatches in variadics
+// EXIT=2
+
+generic type ordered where
+    A, B : ordered
+    Test : boolean := A < B
+
+function Max (X : ordered) return ordered is
+    return X
+
+function Max (X : ordered; ...) return ordered is
+    result := Max(...)
+    if result < X then
+        result := X
+
+Test_integer : integer := Max(1, 2, 4, 6)
+Test_bad     : integer := Max(1, 2.5)

xl2/native/TESTS/10.Generics/multiple_parameters.ref

@@ -0,0 +1,78 @@
+#include <stdio.h>
+typedef char                   xlint8;
+typedef short                  xlint16;
+typedef int                    xlint32;
+typedef long long              xlint64;
+typedef unsigned char          xluint8;
+typedef unsigned short         xluint16;
+typedef unsigned int           xluint32;
+typedef unsigned long long     xluint64;
+typedef float                  xlreal32;
+typedef double                 xlreal64;
+typedef int                    xlint;
+typedef unsigned               xluint;
+typedef double                 xlreal;
+typedef char                   xlbool;
+typedef char                   xlchar;
+typedef const char *           xltext;
+typedef void *                 xlptr;
+typedef struct {} /* !ANSIC */ xlrecord, xlmodule;
+typedef FILE *                 xlfile;
+xlfile xl_getstdfile(int n) {
+  switch(n) {
+    case 0: return stdin;
+    case 1: return stdout;
+    case 2: return stderr;
+  }
+  return NULL;
+}
+typedef struct Record_954 {
+  xlmodule baserecord_1; /* RecF */
+} Record_954;
+Record_954 xlbuiltins_955; /* Global */
+xlint ret_979; /* Temp */
+xlint ret_980; /* Temp */
+xlint q_962; /* Global */
+xlint z_970; /* Global */
+typedef xlint (*FnPtr_975) ( xlint a_973 , xlint b_974 ) ;
+xlint f_976 ( xlint a_973 , xlint b_974 ) ;
+typedef xlint (*FnPtr_985) ( xlint a_981 , xlint b_982 , xlint c_983 , xlint d_984 ) ;
+xlint g_986 ( xlint a_981 , xlint b_982 , xlint c_983 , xlint d_984 ) ;
+xlint ret_991; /* Temp */
+xlint f_976 ( xlint a_973 , xlint b_974 ) {
+xlint ret_978; /* Temp */
+xlint result_977; /* Result */
+ret_978 = a_973 + b_974;
+result_977 = ret_978;
+goto exit_f_976;
+exit_f_976: 0;
+return result_977;
+}
+xlint g_986 ( xlint a_981 , xlint b_982 , xlint c_983 , xlint d_984 ) {
+xlint ret_988; /* Temp */
+xlint ret_989; /* Temp */
+xlint ret_990; /* Temp */
+xlint result_987; /* Result */
+ret_988 = b_982 * c_983;
+ret_989 = ret_988 / d_984;
+ret_990 = a_981 + ret_989;
+result_987 = ret_990;
+goto exit_g_986;
+exit_g_986: 0;
+return result_987;
+}
+int main(int _argc, char **_argv)
+{
+xlint ret_979; /* Temp */
+xlint ret_980; /* Temp */
+xlint ret_991; /* Temp */
+ret_979 = f_976 ( 1 , 5 );
+q_962 = ret_979;
+ret_980 = -3;
+ret_991 = g_986 ( 1 , ret_980 , 6 , 4 );
+z_970 = ret_991;
+/* Type */
+    /* Main */
+    return 0;
+}
+/*end*/

xl2/native/TESTS/10.Generics/multiple_parameters.xl

@@ -0,0 +1,14 @@
+// Check that we can instantiate with multiple parameters
+// RUN=cat %c
+generic type ordered
+
+function F(A : ordered; B : ordered) return ordered is
+    return A + B
+
+Q : integer := F(1, 5)
+
+function G(A, B : ordered; C : ordered; D : ordered) return ordered is
+    return A + B * C/D
+
+Z : integer := G(1, -3, 6,4)
+

xl2/native/TESTS/10.Generics/validated_generic_with_local_type.ref

@@ -0,0 +1,92 @@
+#include <stdio.h>
+typedef char                   xlint8;
+typedef short                  xlint16;
+typedef int                    xlint32;
+typedef long long              xlint64;
+typedef unsigned char          xluint8;
+typedef unsigned short         xluint16;
+typedef unsigned int           xluint32;
+typedef unsigned long long     xluint64;
+typedef float                  xlreal32;
+typedef double                 xlreal64;
+typedef int                    xlint;
+typedef unsigned               xluint;
+typedef double                 xlreal;
+typedef char                   xlbool;
+typedef char                   xlchar;
+typedef const char *           xltext;
+typedef void *                 xlptr;
+typedef struct {} /* !ANSIC */ xlrecord, xlmodule;
+typedef FILE *                 xlfile;
+xlfile xl_getstdfile(int n) {
+  switch(n) {
+    case 0: return stdin;
+    case 1: return stdout;
+    case 2: return stderr;
+  }
+  return NULL;
+}
+typedef struct Record_954 {
+  xlmodule baserecord_1; /* RecF */
+} Record_954;
+Record_954 xlbuiltins_955; /* Global */
+typedef struct Record_965 {
+  xlrecord baserecord_961; /* RecF */
+  xlreal re_962; /* RecF */
+  xlreal im_963; /* RecF */
+} Record_965;
+typedef xlbool (*FnPtr_968) ( Record_965 x_966 , Record_965 y_967 ) ;
+xlbool lessthan_969 ( Record_965 x_966 , Record_965 y_967 ) ;
+typedef Record_965 (*FnPtr_972) ( Record_965 src_971 ) ;
+Record_965 copy_973 ( Record_965 src_971 ) ;
+Record_965 z_974; /* Global */
+typedef Record_965 (*FnPtr_987) ( Record_965 x_986 ) ;
+Record_965 max_988 ( Record_965 x_986 ) ;
+Record_965 ret_991; /* Temp */
+Record_965 outret_992; /* Ret */
+xlbool lessthan_969 ( Record_965 x_966 , Record_965 y_967 ) {
+xlbool ret_977; /* Temp */
+xlbool result_976; /* Result */
+ret_977 = lessthan_969 ( x_966 , y_967 );
+result_976 = ret_977;
+goto exit_lessthan_969;
+exit_lessthan_969: 0;
+return result_976;
+}
+Record_965 copy_973 ( Record_965 src_971 ) {
+Record_965 tgt_970; /* Out=Ret */
+/* xlreal fld_978; Ref */
+/* xlreal fld_979; Ref */
+/* xlreal fld_980; Ref */
+/* xlreal fld_981; Ref */
+#define fld_979 (tgt_970.re_962)
+#define fld_978 (src_971.re_962)
+fld_979 = fld_978;
+#define fld_981 (tgt_970.im_963)
+#define fld_980 (src_971.im_963)
+fld_981 = fld_980;
+exit_copy_973: 0;
+return tgt_970;
+}
+Record_965 max_988 ( Record_965 x_986 ) {
+Record_965 outret_990; /* Ret */
+Record_965 result_989; /* Result */
+outret_990 = copy_973 ( x_986 );
+result_989 = outret_990;
+goto exit_max_988;
+exit_max_988: 0;
+return result_989;
+}
+int main(int _argc, char **_argv)
+{
+Record_965 ret_991; /* Temp */
+Record_965 outret_992; /* Ret */
+ret_991 = max_988 ( z_974 );
+outret_992 = copy_973 ( ret_991 );
+z_974 = outret_992;
+/* Type */
+/* Type */
+    /* Main */
+    return 0;
+}
+/*end*/

xl2/native/TESTS/10.Generics/validated_generic_with_local_type.xl

@@ -0,0 +1,20 @@
+// The quintessential XL test now passes :-)
+// RUN=cat %c
+
+generic type ordered where
+    A, B : ordered
+    Test : boolean := A < B
+
+function Max (X : ordered) return ordered is
+    return X
+
+type complex is record with
+    re, im : real
+
+function LessThan (X, Y : complex) return boolean written X<Y is
+    return X < Y
+to Copy (out Tgt : complex; in Src : complex) written Tgt := Src is
+    Tgt.re := Src.re
+    Tgt.im := Src.im
+
+Z : complex := Max(z)

xl2/native/TESTS/12.Library/hello_world_short.ref

@@ -0,0 +1,2 @@
+Hello World
+One=1 Two=2 and K=17

xl2/native/TESTS/12.Library/hello_world_short.xl

@@ -0,0 +1,7 @@
+// This test checks text I/O operations
+use XL.UI.CONSOLE
+
+K : integer := 17
+
+WriteLn "Hello World"
+WriteLn "One=", 1, " Two=", 2, " and K=", K

xl2/native/xl.codegenerator.machine.xl

@@ -208,9 +208,7 @@ module XL.CODE_GENERATOR.MACHINE is
                 'retDecl'
                 @fn_retN_end
             XLT.AddGlobalDecl retDecl
-            result := parse_tree
-                'result'
-                @fn_retN 'BaseName'
+            result := XLT.Append(result, parse_tree(@fn_retN 'BaseName'))
 
         // Follow the return value declaration with name
         result := parse_tree