1# Test all kinds of basic features of the compiler, e.g.
2# whether it compiles constants correctly.
3
4#
5# test handling of integer constants of various sizes
6#
7test_int_constants := function()
8    local x, y;
9
10    # integer constants < 2^28
11    x := 10^5;
12    Print(x, "\n");
13    y := 100000;
14    Print(y, "\n");
15    Print(x = y, "\n");
16
17    # integer constants between 2^28 and 2^60
18    x := 10^10;
19    Print(x, "\n");
20    y := 10000000000;
21    Print(y, "\n");
22    Print(x = y, "\n");
23
24    # integer constants > 2^60
25    x := 10^20;
26    Print(x, "\n");
27    y := 100000000000000000000;
28    Print(y, "\n");
29    Print(x = y, "\n");
30end;
31
32
33#
34# Test calls to functions with 0 to 6 args, and >= 6 args
35#
36test_func_calls := function()
37    local vararg_fun;
38
39    # vararg function
40    vararg_fun := function(args...)
41        return Length(args);
42    end;
43
44    #
45    # function calls
46    #
47    Print(vararg_fun(), "\n");
48    Print(vararg_fun(1), "\n");
49    Print(vararg_fun(1,2), "\n");
50    Print(vararg_fun(1,2,3), "\n");
51    Print(vararg_fun(1,2,3,4), "\n");
52    Print(vararg_fun(1,2,3,4,5), "\n");
53    Print(vararg_fun(1,2,3,4,5,6), "\n");
54    Print(vararg_fun(1,2,3,4,5,6,7), "\n");
55    # note that immediate integer arguments are treated differently,
56    # so test with other args, too
57    Print(vararg_fun("x",true,vararg_fun,4,5,6,7), "\n");
58
59    # test function call with options
60    Print(vararg_fun(:myopt), "\n");
61    Print(vararg_fun(:myopt:="value"), "\n");
62
63    # FIXME: the following legal code triggers a bug in GAC!
64#     Print(vararg_fun(:("myopt")), "\n");
65#     Print(vararg_fun(:("myopt"):="value"), "\n");
66
67
68    #
69    # procedure calls (i.e. func calls as statements)
70    #
71    vararg_fun := function(args...)
72        Display(Length(args));
73    end;
74    vararg_fun();
75    vararg_fun(1);
76    vararg_fun(1,2);
77    vararg_fun(1,2,3);
78    vararg_fun(1,2,3,4);
79    vararg_fun(1,2,3,4,5);
80    vararg_fun(1,2,3,4,5,6);
81    vararg_fun(1,2,3,4,5,6,7);
82    # note that immediate integer arguments are treated differently,
83    # so test with other args, too
84    vararg_fun("x",true,vararg_fun,4,5,6,7);
85
86    # test function call with options
87    vararg_fun(:myopt);
88    vararg_fun(:myopt:="value");
89
90    # FIXME: the following legal code triggers a bug in GAC!
91#     vararg_fun(:("myopt"));
92#     vararg_fun(:("myopt"):="value");
93
94end;
95
96
97#
98# tests for binary operators '=', '<>', '<', '<=', '>', '>=', each
99# once compared as an independent expression (which returns the GAP
100# objects 'True' or 'False'), and once as condition in an 'if'
101# (which avoids use of 'True' and 'False'). Also test optimizations
102# for immediate integers args
103#
104test_cmp_ops := function()
105    local x;
106
107    Print("setting x to 2 ...\n");
108    x := 2;
109
110    # =
111    Print("1 = 2 is ", 1 = 2, "\n");
112    Print("1 = x is ", 1 = x, "\n");
113    Print("1 = 2 via if is "); if 1 = 2 then Print("true\n"); else Print("false\n"); fi;
114    Print("1 = x via if is "); if 1 = x then Print("true\n"); else Print("false\n"); fi;
115
116    # <>
117    Print("1 <> 2 is ", 1 <> 2, "\n");
118    Print("1 <> x is ", 1 <> x, "\n");
119    Print("1 <> 2 via if is "); if 1 <> 2 then Print("true\n"); else Print("false\n"); fi;
120    Print("1 <> x via if is "); if 1 <> x then Print("true\n"); else Print("false\n"); fi;
121
122    # <
123    Print("1 < 2 is ", 1 < 2, "\n");
124    Print("1 < x is ", 1 < x, "\n");
125    Print("1 < 2 via if is "); if 1 < 2 then Print("true\n"); else Print("false\n"); fi;
126    Print("1 < x via if is "); if 1 < x then Print("true\n"); else Print("false\n"); fi;
127
128    # <=
129    Print("1 <= 2 is ", 1 <= 2, "\n");
130    Print("1 <= x is ", 1 <= x, "\n");
131    Print("1 <= 2 via if is "); if 1 <= 2 then Print("true\n"); else Print("false\n"); fi;
132    Print("1 <= x via if is "); if 1 <= x then Print("true\n"); else Print("false\n"); fi;
133
134    # >
135    Print("1 > 2 is ", 1 > 2, "\n");
136    Print("1 > x is ", 1 > x, "\n");
137    Print("1 > 2 via if is "); if 1 > 2 then Print("true\n"); else Print("false\n"); fi;
138    Print("1 > x via if is "); if 1 > x then Print("true\n"); else Print("false\n"); fi;
139
140    # >=
141    Print("1 >= 2 is ", 1 >= 2, "\n");
142    Print("1 >= x is ", 1 >= x, "\n");
143    Print("1 >= 2 via if is "); if 1 >= 2 then Print("true\n"); else Print("false\n"); fi;
144    Print("1 >= x via if is "); if 1 >= x then Print("true\n"); else Print("false\n"); fi;
145end;
146
147
148#
149# arithmetic tests
150#
151test_arith := function()
152    local x;
153
154    # additive inverse
155    x := 5;
156    x := -x;
157    x := 1/2;
158    x := -x;
159end;
160
161
162#
163# test tilde expressions
164#
165test_tilde := function()
166    local x;
167
168# FIXME: handling of tilde expressions is currently broken in gac
169#
170#     # list tilde expression
171#     x := [~];
172#     Display(x);
173#
174#     # record tilde expression
175#     x := rec( next := ~);
176#     Display(x);
177#
178#     # tilde expression
179#     x := [ [ 1, 2 ], ~[ 1 ] ];
180#     Display(x);
181end;
182
183
184#
185#
186#
187test_list_rec_exprs := function()
188    local l, x;
189
190    Display( [ ] );
191    Display( [ 1, 2, 3 ] );
192    Display( [ 1, , 3, [ 4, 5 ], rec( x := [ 6, rec(), ] ) ] );
193
194    l := [];
195    l[1] := 1;
196    l[1 + 1] := 2;
197    l![3] := 3;
198    l![2+2] := 4;
199    Display(l);
200    Print("l[1] = ", l[1], "\n");
201    Print("l[2] = ", l[1+1], "\n");
202    Print("l[3] = ", l![3], "\n");
203    Print("l[4] = ", l![2+2], "\n");
204
205    x := rec(a:=1);
206    x.b := 2;
207    x.("c") := x.a + x.("b");
208    x!.d := 42;
209    x!.("e") := 23;
210    Display(x);
211    Print("x.a = ", x.a, "\n");
212    Print("x.b = ", x.("b"), "\n");
213    Print("x.d = ", x!.d, "\n");
214    Print("x.e = ", x!.("e"), "\n");
215end;
216
217
218#
219# IsBound / Unbind
220#
221myglobal := 1;
222test_IsBound_Unbind := function()
223    local x;
224
225    #
226    Print("Testing IsBound and Unbind for lvar\n");
227    x := 42;
228    Display(IsBound(x));
229    Unbind(x);
230    Display(IsBound(x));
231
232    #
233    Print("Testing IsBound and Unbind for gvar\n");
234    myglobal := 42;
235    Display(IsBound(myglobal));
236    Unbind(myglobal);
237    Display(IsBound(myglobal));
238
239    #
240    Print("Testing IsBound and Unbind for list\n");
241    x := [1,2,3];
242    Display(IsBound(x[2]));
243    Unbind(x[2]);
244    Display(IsBound(x[2]));
245
246    #
247    Print("Testing IsBound and Unbind for list with bang\n");
248    x := [1,2,3];
249    Display(IsBound(x![2]));
250    Unbind(x![2]);
251    Display(IsBound(x![2]));
252
253    #
254    Print("Testing IsBound and Unbind for record\n");
255    x := rec( a := 1 );
256    Display(IsBound(x.a));
257    Unbind(x.a);
258    Display(IsBound(x.a));
259
260    #
261    Print("Testing IsBound and Unbind for record with expr\n");
262    x := rec( a := 1 );
263    Display(IsBound(x.("a")));
264    Unbind(x.("a"));
265    Display(IsBound(x.("a")));
266
267    #
268    Print("Testing IsBound and Unbind for record with bang\n");
269    x := rec( a := 1 );
270    Display(IsBound(x!.a));
271    Unbind(x!.a);
272    Display(IsBound(x!.a));
273
274    #
275    Print("Testing IsBound and Unbind for record with bang and expr\n");
276    x := rec( a := 1 );
277    Display(IsBound(x!.("a")));
278    Unbind(x!.("a"));
279    Display(IsBound(x!.("a")));
280
281end;
282
283
284#
285#
286#
287test_loops := function()
288    local x;
289
290    Display("testing repeat loop");
291    x := 0;
292    repeat
293        x := x + 1;
294        if x = 1 then
295            continue;
296        elif x = 4 then
297            break;
298        else
299            Display(x);
300        fi;
301    until x >= 100;
302
303    Display("testing while loop");
304    x := 0;
305    while x < 100 do
306        x := x + 1;
307        if x = 1 then
308            continue;
309        elif x = 4 then
310            break;
311        else
312            Display(x);
313        fi;
314    od;
315
316    Display("testing for loop");
317    # for loop
318    for x in [1..100] do
319        if x = 1 then
320            continue;
321        elif x = 4 then
322            break;
323        else
324            Display(x);
325        fi;
326    od;
327
328end;
329
330
331#
332# run all tests
333#
334runtest := function()
335    test_int_constants();
336    test_func_calls();
337    test_cmp_ops();
338    test_arith();
339    test_tilde();
340    test_list_rec_exprs();
341    test_IsBound_Unbind();
342    test_loops();
343
344    # test trivial permutation
345    Display( () );
346end;
347