BEGIN ASSERT (flip = "T");
ASSERT (flop = "F");
ASSERT (error char = "*");
- ASSERT (ABS invalid char = ABS 16rfffd)
+ ASSERT (ABS replacement char = ABS 16rfffd)
END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 0, n := 5;
+ TO n + 1 DO i +:= 1 OD;
+ ASSERT (i = 6)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 0, n := 2;
+ FOR a TO n + 1 DO i +:= a OD;
+ ASSERT (i = 1 + 2 + 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 0, n := 2;
+ FOR a FROM n TO n + 2 DO i +:= a OD;
+ ASSERT (i = 2 + 3 + 4)
+END
--- /dev/null
+{ Test for overflow/underflow in loops with implicit and explicit
+ iterators. }
+
+begin int count;
+
+ { Overflow. }
+ count := 0;
+ by 1 while true do count +:= 1 od;
+ assert (count = max_int);
+
+ count := 0;
+ from max_int do count +:= 1 od;
+ assert (count = 1);
+ count := 0;
+
+ by max_int do count +:= 1 od;
+ assert (count = 1);
+
+ count := 0;
+ for i by max_int do count +:= 1 od;
+ assert (count = 1);
+
+ count := 0;
+ by max_int % 2 do count +:= 1 od;
+ assert (count = 3);
+
+ count := 0;
+ by max_int - 1 do count +:= 1 od;
+ assert (count = 2);
+
+ { Underflow. }
+ count := 0;
+ by -1 while true do count +:= 1 od;
+ assert (count = -min_int + 2);
+
+ count := 0;
+ from min_int by -1 do count +:= 1 od;
+ assert (count = 1);
+ count := 0;
+
+ by min_int do count +:= 1 od;
+ assert (count = 2);
+
+ count := 0;
+ for i by min_int do count +:= 1 od;
+ assert (count = 2);
+
+ count := 0;
+ by min_int % 2 do count +:= 1 od;
+ assert (count = 3);
+
+ count := 0;
+ by min_int + 1 do count +:= 1 od;
+ assert (count = 2)
+end
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 12;
+ LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12;
+ SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12;
+ ASSERT (i < 13);
+ ASSERT (ii LT LONG 13);
+ ASSERT (iii < LONG LONG 13);
+ ASSERT (s < SHORT 13);
+ ASSERT (ss < SHORT SHORT 13)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]CHAR matrix = (("1", "Z", "1"),
+ ("4", "Y", "4"),
+ ("7", "X", "9"));
+ ASSERT (matrix[1:3,1] < matrix[1:3,3]);
+ ASSERT (("1","4","0") < matrix[1:3,3])
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (LWB "foo" = 1);
+ ASSERT (LWB "" = 1);
+ ASSERT (1 LWB "foo" = 1);
+ ASSERT (1 LWB "" = 1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 10;
+ LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+ SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+ ASSERT (i - 2 = 8);
+ ASSERT (ii - LONG 2 = LONG 8);
+ ASSERT (iii - LONG LONG 2 = LONG LONG 8);
+ ASSERT (ss - SHORT 2 = SHORT 8);
+ ASSERT (sss - SHORT SHORT 2 = SHORT SHORT 8)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN BEGIN INT i := 10;
+ i -:= 2;
+ ASSERT (i = 8);
+ i MINUSAB 2;
+ ASSERT (i = 6)
+ END;
+ BEGIN LONG INT i := LONG 1000;
+ i -:= LONG 100;
+ ASSERT (i = LONG 900);
+ i MINUSAB LONG 100;
+ ASSERT (i = LONG 800)
+ END;
+ BEGIN LONG LONG INT i := LONG LONG 10000;
+ i -:= LONG LONG 1000;
+ ASSERT (i = LONG LONG 9000);
+ i MINUSAB LONG LONG 1000;
+ ASSERT (i = LONG LONG 8000)
+ END;
+ BEGIN SHORT INT i := SHORT 100;
+ i -:= SHORT 10;
+ ASSERT (i = SHORT 90);
+ i MINUSAB SHORT 10;
+ ASSERT (i = SHORT 80)
+ END;
+ BEGIN SHORT SHORT INT i := SHORT SHORT 10;
+ i -:= SHORT SHORT 1;
+ ASSERT (i = SHORT SHORT 9);
+ i MINUSAB SHORT SHORT 2;
+ ASSERT (i = SHORT SHORT 7)
+ END
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN BEGIN REAL i := 10.0;
+ i -:= 2.0;
+ ASSERT (i = 8.0);
+ i MINUSAB 2.0;
+ ASSERT (i = 6.0)
+ END;
+ BEGIN LONG REAL i := LONG 1000.0;
+ i -:= LONG 100.0;
+ ASSERT (i = LONG 900.0);
+ i MINUSAB LONG 100.0;
+ ASSERT (i = LONG 800.0)
+ END;
+ BEGIN LONG LONG REAL i := LONG LONG 10000.0;
+ i -:= LONG LONG 1000.0;
+ ASSERT (i = LONG LONG 9000.0);
+ i MINUSAB LONG LONG 1000.0;
+ ASSERT (i = LONG LONG 8000.0)
+ END
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := 10;
+ (((n -:= 1))) := 5;
+ ASSERT (n = 5)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT num ints := 10;
+ num ints -:= 1;
+ ASSERT (num ints = 9);
+ ASSERT ((LOC INT -:= 12) = -12)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 10;
+ LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+ SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+ ASSERT (i %* 3 = 1);
+ ASSERT (ii %* LONG 3 = LONG 1);
+ ASSERT (iii %* LONG LONG 3 = LONG LONG 1);
+ ASSERT (ss %* SHORT 3 = SHORT 1);
+ ASSERT (sss MOD SHORT SHORT 3 = SHORT SHORT 1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN (SHORT SHORT INT i := SHORT SHORT 11; i MODAB SHORT SHORT 2; ASSERT (i = SHORT SHORT 1));
+ (SHORT INT i := SHORT 11; i MODAB SHORT 2; ASSERT (i = SHORT 1));
+ (INT i := 11; i MODAB 2; ASSERT (i = 1));
+ (INT i := 11; i %*:= 2; ASSERT (i = 1));
+ (LONG INT i := LONG 11; i MODAB LONG 2; ASSERT (i = LONG 1));
+ (LONG INT i := LONG 11; i %*:= LONG 2; ASSERT (i = LONG 1));
+ (LONG LONG INT i := LONG LONG 11; i MODAB LONG LONG 2; ASSERT (i = LONG LONG 1));
+ (LONG LONG INT i := LONG LONG 11; i %*:= LONG LONG 2; ASSERT (i = LONG LONG 1))
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := 10;
+ (((n MODAB 1))) := 5;
+ ASSERT (n = 5)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT j; REAL y;
+ MODE R = REAL;
+ BEGIN MODE R = INT;
+ R i := j;
+ SKIP
+ END;
+ R x := y;
+ SKIP
+END
--- /dev/null
+This directory contains tests that require using several packets.
+
+Files named module*.a68 contain prelude packets, i.e. the definitions
+of one or more modules. These are to be referred within test programs
+using dg-modules.
+
+Each program*.a68 file is a testcase.
--- /dev/null
+# Copyright (C) 2024 Free Software Foundation, Inc.
+
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# Execute tests, torture testing.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+load_lib algol68-torture.exp
+load_lib torture-options.exp
+
+torture-init
+set-torture-options $TORTURE_OPTIONS
+
+# The programs need to be able to find the built modules, which are
+# left in objdir.
+global BUILT_MODULES_DIR
+set BUILT_MODULES_DIR "$objdir"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/program-*.a68]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+ algol68-torture-execute $testcase
+ set algol68_compile_args ""
+}
+
+torture-finish
--- /dev/null
+module Module1 =
+def
+ pub mode MyInt = int;
+ pub int beast_number := 666;
+ pub string who = "jemarch";
+ puts ("Hello from module'n")
+postlude
+ puts ("Bye from module'n")
+fed
--- /dev/null
+module Module10 =
+access Module9, Module3
+def int je = foo;
+ prio QUUX = 9;
+ pub Lala bar = (bump; getcounter); {11}
+ skip
+fed
--- /dev/null
+{ Mixing module texts with revelations and without revelations. }
+
+module Module11 =
+ access Module1, Module3
+ def pub proc someproc = (int a, b) int: a + b;
+ skip
+ postlude
+ skip
+ fed,
+ Foo = def skip postlude skip fed,
+ Bar = def skip fed
--- /dev/null
+module Module_12 =
+def pub proc foo = (proc(int,string)void cb, int a) void: cb (a, "Foo");
+ pub proc bar = (real r) void: skip;
+ skip
+fed
--- /dev/null
+module Module_13 =
+def
+ pub mode JSON_Val = struct (int i);
+ skip
+fed
--- /dev/null
+module Module14 =
+access Module13
+def pub proc getval = JSON_Val: skip;
+ skip
+fed
--- /dev/null
+module Module15 =
+access Module13, Module14
+def pub proc foo = int:
+ begin JSON_Val val = getval;
+ i of val
+ end;
+ skip
+fed
--- /dev/null
+module Module_16 =
+def
+ pub int counter;
+ skip
+postlude
+ assert (counter = 666);
+ skip
+fed
--- /dev/null
+module Module =
+def
+ pub int ce_port;
+ pub string ce_host;
+
+ pub proc ce_connect = void:
+ myconnect (ce_host, ce_port);
+
+ proc myconnect = (string host, int port) void:
+ skip;
+
+ skip
+fed
--- /dev/null
+module Module_3 =
+def
+ { variable = 0 in_proc = 1 } pub proc bump = void: counter +:= 1;
+ { variable = 0 in_proc = 1 } pub proc bumptimes = (int n) void: to n do bump od;
+ { variable = 1 in_proc = 0 } pub proc vbump := void: counter +:= 1;
+ { variable = 1 in_proc = 0 } pub proc vbumptimes := (int n) void: to n do vbump od;
+ { variable = 0 in_proc = 1 } pub proc getcounter = int: counter;
+ { variable = 0 in_proc = 0 } pub proc int anothergetcounter = getcounter;
+ int counter := 10;
+ skip
+fed
--- /dev/null
+module Module_4 =
+def pub int ten = 10;
+ skip
+fed
--- /dev/null
+module Module_5 =
+def pub prio // = 9;
+ pub op // = (int a, b) int: a + b;
+ pub prio LALA = 9;
+ pub op LALA = (int a, b) int: a - b;
+ skip
+fed
--- /dev/null
+module Module_6 =
+def prio // = 9; { Note priority is not publicized. }
+ pub op // = (int a, b) int: a + b;
+ skip
+fed
--- /dev/null
+{ This module exports an operator defined in a non-brief operator
+ declaration. This means the exported symbol is a pointer to a
+ function and shall be indirected on the accessing side. }
+
+module Module_7 =
+def pub prio MINUS = 9;
+ pub op (int,int)int MINUS = minus;
+ proc minus = (int a, b) int: a - b;
+ skip
+fed
--- /dev/null
+module Module_8 =
+access Module_1, Module_4
+def
+ pub proc checks = void:
+ begin assert (ten = 10);
+ assert (beast_number = 666)
+ end;
+ skip
+fed
--- /dev/null
+module Module9 =
+def pub int foo = 10;
+ pub prio // = 9;
+ pub op QUUX = (int a, b) int: a + b;
+ prio QUUX = 9;
+ pub mode Lala = int;
+ skip
+fed
--- /dev/null
+{ dg-modules "module1" }
+
+begin string je = access Module1 begin who end;
+ string ju = access Module1 ( who );
+ string ji = access Module1 if true then who else who fi;
+ string ja = access Module1 (true | who | who);
+ string aa = access Module1 case 1 in who, "no" esac;
+ mode United = union (void,int);
+ string bb = access Module1 case United (10) in (int): who esac;
+ string cc = access Module1 (1 | who, "no");
+ assert (je = "jemarch");
+ assert (ju = "jemarch");
+ assert (ji = "jemarch");
+ assert (ja = "jemarch");
+ assert (aa = "jemarch");
+ assert (bb = "jemarch");
+ assert (cc = "jemarch");
+ access Module1 to 1 do assert (who = "jemarch") od;
+ access Module1 (assert (beast_number = 666))
+end
--- /dev/null
+{ dg-modules "module3 module9 module10" }
+
+access Module10
+begin int x = 11;
+ assert (x = bar)
+end
--- /dev/null
+{ dg-modules "module1 module3 module11" }
+
+access Module11 ( assert (someproc (2, 3) = 5))
--- /dev/null
+{ dg-modules "module12" }
+
+access Module_12
+begin proc lala = (int n, string s) void: skip;
+ foo (lala, 10)
+end
--- /dev/null
+{ dg-modules "module13 module14 module15" }
+
+access Module15 (assert (foo = 0))
--- /dev/null
+{ dg-modules module16 }
+
+access Module_16
+begin assert (counter = 0);
+ counter := 20;
+ access Module_16 (assert (counter = 20));
+ counter := 666
+end
--- /dev/null
+{ dg-modules module17 }
+
+access Module17
+begin ce_port := 8888;
+ ce_host := "localhost";
+ ce_connect
+end
--- /dev/null
+{ dg-modules "module1" }
+
+begin int x = 1 + access Module1 ( beast_number);
+ int i = access Module1 ( beast_number ) + 1;
+ int z = 1 + access Module1 if true then beast_number fi;
+ int v = access Module1 if true then beast_number fi + 1;
+ int w = access Module1 if true then beast_number fi
+ + access Module1 if true then beast_number fi;
+ assert (i = 667);
+ assert (x = 667);
+ assert (z = 667);
+ assert (v = 667);
+ assert (w = 666 * 2);
+ skip
+end
--- /dev/null
+{ dg-modules "module3" }
+
+access Module_3
+begin assert (getcounter = 10);
+ bump;
+ assert (getcounter = 11);
+ bumptimes (3);
+ assert (getcounter = 14)
+ { vbump and vbumptimes are set to non-publicized routines
+ that are local to the module, so it is a scope violation
+ to call them. }
+{ vbump;
+ assert (getcounter = 15);
+ vbumptimes (10);
+ assert (anothergetcounter = 25) }
+end
--- /dev/null
+{ dg-modules "module4" }
+
+{ The widening coercion "jumps" inside the controlled xclause. }
+
+begin real realten = access Module_4 (ten);
+ skip
+end
--- /dev/null
+{ dg-modules "module5" }
+
+access Module_5
+begin assert (2 // 3 = 5);
+ assert (2 LALA 3 = -1);
+ skip
+end
--- /dev/null
+{ dg-modules "module6" }
+
+{ New priority is given to an importe operator. }
+
+access Module_6
+begin assert (2 // 3 = 5);
+ prio // = 9;
+ skip
+end
--- /dev/null
+{ dg-modules "module7" }
+
+access Module_7 ( assert (2 MINUS 3 = -1) )
--- /dev/null
+{ dg-modules "module1 module4 module8" }
+
+access Module_8 (checks)
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT ("a" * 3 = "aaa");
+ ASSERT ("" * 1 = "");
+ ASSERT ("x" * 0 = "x")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 10;
+ LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+ SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+ ASSERT (i * 2 = 20);
+ ASSERT (ii * LONG 2 = LONG 20);
+ ASSERT (iii * LONG LONG 2 = LONG LONG 20);
+ ASSERT (ss * SHORT 2 = SHORT 20);
+ ASSERT (sss * SHORT SHORT 2 = SHORT SHORT 20)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING foo = "foo";
+ ASSERT (foo * -10 = "foo");
+ ASSERT (-10 * foo = "foo");
+ ASSERT (foo * 0 = "foo");
+ ASSERT (0 * foo = "foo");
+ ASSERT (foo * 1 = "foo");
+ ASSERT (1 * foo = "foo");
+ ASSERT (foo * 2 = "foofoo");
+ ASSERT (2 * foo = "foofoo");
+ ASSERT (foo * 3 = "foofoofoo");
+ ASSERT (3 * foo = "foofoofoo")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []CHAR foo = ("f","o","o");
+ ASSERT (foo * -10 = "foo");
+ ASSERT (-10 * foo = "foo");
+ ASSERT (foo * 0 = "foo");
+ ASSERT (0 * foo = "foo");
+ ASSERT (foo * 1 = "foo");
+ ASSERT (1 * foo = "foo");
+ ASSERT (foo * 2 = "foofoo");
+ ASSERT (2 * foo = "foofoo");
+ ASSERT (foo * 3 = "foofoofoo");
+ ASSERT (3 * foo = "foofoofoo")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN FLEX[3]CHAR foo := ("f","o","o");
+ ASSERT (foo * -10 = "foo");
+ ASSERT (-10 * foo = "foo");
+ ASSERT (foo * 0 = "foo");
+ ASSERT (0 * foo = "foo");
+ ASSERT (foo * 1 = "foo");
+ ASSERT (1 * foo = "foo");
+ ASSERT (foo * 2 = "foofoo");
+ ASSERT (2 * foo = "foofoo");
+ ASSERT (foo * 3 = "foofoofoo");
+ ASSERT (3 * foo = "foofoofoo")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING foo = "abc";
+ ASSERT (foo[] * 2 = "abcabc")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 2;
+ i *:= 2;
+ ASSERT (i = 4);
+ i *:= 2;
+ ASSERT (i = 8);
+
+ SHORT INT s := SHORT 2;
+ s *:= SHORT 2;
+ ASSERT (s = SHORT 4);
+ s *:= SHORT 3;
+ ASSERT (s = SHORT 12);
+
+ SHORT SHORT INT ss := SHORT SHORT 2;
+ ss *:= SHORT SHORT 2;
+ ASSERT (ss = SHORT SHORT 4);
+ ss *:= SHORT SHORT 3;
+ ASSERT (ss = SHORT SHORT 12);
+
+ REF LONG INT ii = HEAP LONG INT := LONG 2;
+ ii *:= LONG 2;
+ ASSERT (ii = LONG 4);
+ ii *:= LONG 2;
+ ASSERT (ii = LONG 8);
+
+ LONG LONG INT iii := LONG LONG 2;
+ iii *:= LONG LONG 2;
+ ASSERT (iii = LONG LONG 4);
+ iii *:= LONG LONG 2;
+ ASSERT (iii = LONG LONG 8)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 2;
+ i TIMESAB 2;
+ ASSERT (i = 4);
+ i TIMESAB 2;
+ ASSERT (i = 8);
+
+ REF SHORT INT ss = HEAP SHORT INT := SHORT 2;
+ ss TIMESAB SHORT 2;
+ ASSERT (ss = SHORT 4);
+ ss TIMESAB SHORT 2;
+ ASSERT (ss = SHORT 8);
+
+ SHORT SHORT INT sss := SHORT SHORT 2;
+ sss TIMESAB SHORT SHORT 2;
+ ASSERT (sss = SHORT SHORT 4);
+ sss TIMESAB SHORT SHORT 2;
+ ASSERT (sss = SHORT SHORT 8);
+
+ REF LONG INT ii = HEAP LONG INT := LONG 2;
+ ii TIMESAB LONG 2;
+ ASSERT (ii = LONG 4);
+ ii TIMESAB LONG 2;
+ ASSERT (ii = LONG 8);
+
+ LONG LONG INT iii := LONG LONG 2;
+ iii TIMESAB LONG LONG 2;
+ ASSERT (iii = LONG LONG 4);
+ iii TIMESAB LONG LONG 2;
+ ASSERT (iii = LONG LONG 8)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT num ints := 10;
+ num ints *:= 2;
+ ASSERT (num ints = 20);
+ ASSERT ((LOC INT *:= 12) = 0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC is even = (INT n) BOOL: (n = 0 | TRUE | is odd (n - 1));
+ PROC is odd = (INT n) BOOL: (n = 0 | FALSE | is even (n - 1));
+ ASSERT (is even (20));
+ ASSERT (is odd (13))
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN BITS b, LONG BITS bb = LONG 16rff, LONG LONG BITS bbb;
+ SHORT BITS ss = SHORT 16rff, SHORT SHORT BITS sss;
+ ASSERT (b /= 2r1);
+ ASSERT (bb NE LONG 8r477);
+ ASSERT (bbb /= LONG LONG 8r2);
+ ASSERT (ss NE SHORT 8r477);
+ ASSERT (sss /= SHORT SHORT 8r2)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT ("x" /= "a")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 12;
+ LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12;
+ SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12;
+ ASSERT (13 /= i);
+ ASSERT (ii NE LONG 13);
+ ASSERT (iii /= LONG LONG 13);
+ ASSERT (s /= SHORT 13);
+ ASSERT (ss /= SHORT SHORT 13)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING foo = "foo", bar = "bar", quux = "quux";
+ # /= #
+ ASSERT (NOT ("" /= ""));
+ ASSERT (NOT ("foo" /= foo));
+ ASSERT (foo /= bar);
+ ASSERT (foo /= quux);
+ ASSERT (quux /= foo);
+ # NE #
+ ASSERT (NOT ("" NE ""));
+ ASSERT (NOT ("foo" NE foo));
+ ASSERT (foo NE bar);
+ ASSERT (foo NE quux);
+ ASSERT (quux NE foo)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 10;
+ LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+ SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+ ASSERT (-i = -10);
+ ASSERT (-ii = - LONG 10);
+ ASSERT (-iii = - LONG LONG 10);
+ ASSERT (-ss = - SHORT 10);
+ ASSERT (-sss = - SHORT SHORT 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# NOT for SIZETY BITS. #
+BEGIN BITS b = 16rf0f0;
+ ASSERT ((NOT b AND 16rffff) = 16r0f0f);
+ LONG BITS bb = LONG 16rf0f0;
+ ASSERT ((NOT bb AND LONG 16rffff) = LONG 16r0f0f);
+ LONG LONG BITS bbb = LONG LONG 16rf0f0;
+ ASSERT ((NOT bbb AND LONG LONG 16rffff) = LONG LONG 16r0f0f);
+ SHORT BITS ss = SHORT 16rf0f0;
+ ASSERT ((NOT ss AND SHORT 16rffff) = SHORT 16r0f0f);
+ SHORT SHORT BITS sss = SHORT SHORT 16rf0f0;
+ ASSERT ((NOT sss AND SHORT SHORT 16rffff) = SHORT SHORT 16r0f0f)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT a = 1;
+ ASSERT (ODD a);
+ ASSERT (ODD LONG 3);
+ ASSERT (NOT ODD LONG LONG 4);
+ ASSERT (ODD SHORT 3);
+ ASSERT (NOT ODD SHORT SHORT 4)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN OP ONEOVER = (REAL a) REAL: 1/a;
+ REAL x;
+ x := ONEOVER 3.14
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN OP + = (INT a, b) INT: a - -b;
+ ASSERT (10 + 30 = 40)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN OP MIN = (REAL a, b) REAL: (a < b | a | b),
+ MIN = (INT a, REAL b) REAL: (a < b | a | b),
+ MIN = (REAL a, INT b) REAL: a MIN REAL (b);
+ PRIO MIN = 6;
+ ASSERT (10.0 MIN 20.0 > 9.9 AND 10.0 MIN 20.0 < 10.1);
+ ASSERT (10.0 MIN 100 > 9.9 AND 10.0 MIN 100 < 10.1);
+ ASSERT (100.0 MIN 10 > 9.9 AND 100.0 MIN 10 < 10.1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n = 10;
+ # Note that the priority for the monadic operators gets ignored. #
+ PRIO JORL = 6, JURL = 6, XXX = 6, YYY = 6;
+ OP(INT)INT JORL = (n > 10 | (INT a) INT: a + 1 | (INT a) INT: a - 1),
+ JURL = (n <= 10 | (INT a) INT: a + 1 | (INT a) INT: a - 1);
+ OP(INT,INT)INT XXX = (INT a, b) INT: a + b,
+ YYY = (n > 10 | (INT a,b) INT: a * b | (INT a,b) INT: a - b);
+ ASSERT (JORL 10 = 9);
+ ASSERT (JURL 10 = 11);
+ ASSERT (2 XXX 3 = 5);
+ ASSERT (2 YYY 3 = -1);
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# OR for SIZETY BITS. #
+BEGIN BITS b = 16rf0f0;
+ ASSERT ((b OR 16r0f0f) = 16rffff);
+ ASSERT ((b OR 16r00ff) = 16rf0ff);
+ LONG BITS bb = LONG 16rf0f0;
+ ASSERT ((bb OR LONG 16r0f0f) = LONG 16rffff);
+ ASSERT ((bb OR LONG 16r00ff) = LONG 16rf0ff);
+ LONG LONG BITS bbb = LONG LONG 16rf0f0;
+ ASSERT ((bbb OR LONG LONG 16r0f0f) = LONG LONG 16rffff);
+ ASSERT ((bbb OR LONG LONG 16r00ff) = LONG LONG 16rf0ff);
+ SHORT BITS ss = SHORT 16rf0f0;
+ ASSERT ((ss OR SHORT 16r0f0f) = SHORT 16rffff);
+ ASSERT ((ss OR SHORT 16r00ff) = SHORT 16rf0ff);
+ SHORT SHORT BITS sss = SHORT SHORT 16rf0f0;
+ ASSERT ((sss OR SHORT SHORT 16r0f0f) = SHORT SHORT 16rffff);
+ ASSERT ((sss OR SHORT SHORT 16r00ff) = SHORT SHORT 16rf0ff)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 10;
+ ASSERT (i = 0 OREL i = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 10;
+ LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+ SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+ ASSERT (i % 2 = 5);
+ ASSERT (ii % LONG 2 = LONG 5);
+ ASSERT (iii % LONG LONG 2 = LONG LONG 5);
+ ASSERT (ss % SHORT 2 = SHORT 5);
+ ASSERT (sss % SHORT SHORT 2 = SHORT SHORT 5)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN (INT i := 11; i OVERAB 2; ASSERT (i = 5));
+ (INT i := 11; i %:= 2; ASSERT (i = 5));
+ (SHORT INT i := SHORT 11; i OVERAB SHORT 2; ASSERT (i = SHORT 5));
+ (SHORT INT i := SHORT 11; i %:= SHORT 2; ASSERT (i = SHORT 5));
+ (SHORT SHORT INT i := SHORT SHORT 11; i OVERAB SHORT SHORT 2; ASSERT (i = SHORT SHORT 5));
+ (SHORT SHORT INT i := SHORT SHORT 11; i %:= SHORT SHORT 2; ASSERT (i = SHORT SHORT 5));
+ (LONG INT i := LONG 11; i OVERAB LONG 2; ASSERT (i = LONG 5));
+ (LONG INT i := LONG 11; i %:= LONG 2; ASSERT (i = LONG 5));
+ (LONG LONG INT i := LONG LONG 11; i OVERAB LONG LONG 2; ASSERT (i = LONG LONG 5));
+ (LONG LONG INT i := LONG LONG 11; i %:= LONG LONG 2; ASSERT (i = LONG LONG 5))
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := 10;
+ (((n OVERAB 1))) := 5;
+ ASSERT (n = 5)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Particular program with preceding labels. #
+jo: ju:
+BEGIN SKIP END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT ("a" + "b" = "ab");
+ ASSERT ("" + "x" = "x")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 10;
+ LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+ SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+ ASSERT (i + 2 = 12);
+ ASSERT (ii + LONG 2 = LONG 12);
+ ASSERT (iii + LONG LONG 2 = LONG LONG 12);
+ ASSERT (ss + SHORT 2 = SHORT 12);
+ ASSERT (sss + SHORT SHORT 2 = SHORT SHORT 12)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING foo = "foo", bar = "bar", quux = "quux";
+ ASSERT ("" + "" = "");
+ ASSERT ("" + foo = "foo");
+ ASSERT (bar + "" = "bar");
+ ASSERT (foo + bar = "foobar");
+ STRING res = foo + bar;
+ ASSERT (LWB res = 1 AND UPB res = 6);
+ STRING empty = "" + "";
+ ASSERT (LWB empty = 1 AND UPB empty = 0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC rec parse comment = VOID:
+ BEGIN STRING content;
+ done;
+ 100;
+ done:
+ ASSERT (content + "x" = "x")
+ END;
+
+ rec parse comment
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]CHAR matrix = (("1","H","3"),
+ ("4","O","6"),
+ ("7","M","9"),
+ ("8","E","2"));
+ ASSERT (matrix[1:2,1] + matrix[3:4,3] = "1492")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN BEGIN INT i := 10;
+ i +:= 2;
+ ASSERT (i = 12);
+ i PLUSAB 2;
+ ASSERT (i = 14)
+ END;
+
+ BEGIN SHORT INT i := SHORT 1000;
+ i +:= SHORT 100;
+ ASSERT (i = SHORT 1100);
+ i PLUSAB SHORT 100;
+ ASSERT (i = SHORT 1200)
+ END;
+ BEGIN SHORT SHORT INT i := SHORT SHORT 10000;
+ i +:= SHORT SHORT 1000;
+ ASSERT (i = SHORT SHORT 11000);
+ i PLUSAB SHORT SHORT 1000;
+ ASSERT (i = SHORT SHORT 12000)
+ END;
+
+ BEGIN LONG INT i := LONG 1000;
+ i +:= LONG 100;
+ ASSERT (i = LONG 1100);
+ i PLUSAB LONG 100;
+ ASSERT (i = LONG 1200)
+ END;
+ BEGIN LONG LONG INT i := LONG LONG 10000;
+ i +:= LONG LONG 1000;
+ ASSERT (i = LONG LONG 11000);
+ i PLUSAB LONG LONG 1000;
+ ASSERT (i = LONG LONG 12000)
+ END
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN BEGIN REAL i := 10.0;
+ i +:= 2.0;
+ ASSERT (i > 11.9);
+ i PLUSAB 2.0;
+ ASSERT (i > 13.9)
+ END;
+ BEGIN LONG REAL i := LONG 1000.0;
+ i +:= LONG 100.0;
+ ASSERT (i > LONG 1099.9);
+ i PLUSAB LONG 100.0;
+ ASSERT (i > LONG 1199.9)
+ END;
+ BEGIN LONG LONG REAL i := LONG LONG 10000.0;
+ i +:= LONG LONG 1000.0;
+ ASSERT (i > LONG LONG 10999.9);
+ i PLUSAB LONG LONG 1000.0;
+ ASSERT (i > LONG LONG 11999.9)
+ END
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := 0;
+ (((n +:= 1))) := 5;
+ ASSERT (n = 5)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT num ints := 0;
+ num ints +:= 1;
+ ASSERT (num ints = 1);
+ ASSERT ((LOC INT +:= 12) = 12)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING foo := "";
+ foo +:= "foo";
+ ASSERT (LWB foo = 1 AND UPB foo = 3 AND foo = "foo");
+ foo PLUSAB "bar";
+ ASSERT (LWB foo = 1 AND UPB foo = 6 AND foo = "foobar")
+END
--- /dev/null
+begin string foo := "foo";
+ char c := "x";
+ c PLUSTO foo;
+ assert (foo = "xfoo");
+ c +=: foo;
+ assert (foo = "xxfoo")
+end
--- /dev/null
+begin string foo := "foo";
+ "bar" PLUSTO foo;
+ assert (foo = "barfoo");
+ "quux" +=: foo;
+ assert (foo = "quuxbarfoo")
+end
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (argc >= 1);
+ ASSERT (argv (1000) = "");
+ ASSERT (argv (-1) = "");
+ FOR i TO argc
+ DO puts (argv (i)) OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT fd = fopen ("doesn''t exist", file o default);
+ ASSERT (fd = -1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN fputc (stdout, "X");
+ ASSERT (fputs (stdout, "foo") = 3);
+ fputs (stdout, fputc (stdout, "Y") + "T");
+ fputc (stdout, "Z");
+ ASSERT (fputs (stdout, "") = 0);
+ puts ("")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (getenv ("") = "");
+ ASSERT (getenv ("DOESNT EXIST FOR SURE") = "")
+END
--- /dev/null
+begin int fd = fopen ("../../ga68", file_o_rdonly);
+ assert (fd /= -1);
+ assert (errno = 0);
+ long long int offset;
+ offset := lseek (fd, long long 0, seek_cur);
+ assert (offset = long long 0);
+ assert (errno = 0);
+ offset := lseek (fd, long long 0, seek_set);
+ assert (offset = long long 0);
+ assert (errno = 0);
+ offset := lseek (fd, long long 0, seek_end);
+ long long int offset2 = lseek (fd, offset, seek_set);
+ assert (offset = offset2);
+ long long int file_size = fsize (fd);
+ assert (errno = 0);
+ assert (offset = file_size)
+end
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# { dg-output "^something unique: " } #
+BEGIN INT fd = fopen ("doesn''t exist", file o default);
+ IF fd = -1 THEN
+ ASSERT (strerror (errno) /= "");
+ perror ("something unique")
+ FI
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN putchar ("X");
+ putchar ("Y");
+ putchar ("Z");
+ puts ("\n")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (stdin = 0);
+ ASSERT (stdout = 1);
+ ASSERT (stderr = 2)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT fd = fopen ("doesn''t exist", file o default);
+ IF fd = -1 THEN ASSERT (strerror (errno) /= "") FI
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]CHAR matrix = (("1","H","3"),
+ ("4","O","6"),
+ ("7","M","9"),
+ ("8","E","0"));
+ []CHAR column = matrix[1:4,2];
+ puts (column);
+ fputs (stdout, matrix[3,2:3]);
+ puts ("\n");
+ fputs (stdout, matrix[1:3,1]);
+ puts ("\n");
+ puts (getenv (matrix[,2]));
+ perror (matrix[,3])
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 2;
+ LONG INT ii = LONG 2, LONG LONG INT iii = LONG LONG 2;
+ SHORT INT ss = SHORT 2, SHORT SHORT INT sss = SHORT SHORT 2;
+ ASSERT (i ** 2 = 4);
+ ASSERT (ii ** 2 = LONG 4);
+ ASSERT (iii ** 2 = LONG LONG 4);
+ ASSERT (ss ** 2 = SHORT 4);
+ ASSERT (sss ** 2 = SHORT SHORT 4)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN REAL r0 = 2.0; LONG REAL rr0 = LONG 2.0; LONG LONG REAL rrr0 = LONG LONG 2.0;
+ REAL r1 = r0 ^ 2; REAL r2 = r0 ^ 3.0;
+ LONG REAL rr1 = rr0 ^ LONG 2; LONG REAL rr2 = rr0 ^ LONG 3.0;
+ LONG LONG REAL rrr1 = rrr0 ^ LONG LONG 2; LONG LONG REAL rrr2 = rrr0 ^ LONG LONG 3.0;
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC foo = INT: 100;
+ ASSERT (foo = 100)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC(INT,INT)INT foo = (INT i, j) INT: i + j;
+ ASSERT (foo (10, 20) = 30)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC(INT)INT foo = baz;
+ PROC bar = (INT i) INT: i + 1;
+ PROC baz = (INT i) INT: i - 1;
+ ASSERT (foo (10) = 9)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC is even := (INT n) BOOL: n %* 2 = 0;
+ ASSERT (is even (40));
+ PROC no args := BOOL: TRUE;
+ ASSERT (no args)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC is even := (INT n) BOOL: n %* 2 = 0;
+ PROC is odd := (INT n) BOOL: n %* 2 /= 0;
+ PROC(INT)BOOL f = is even;
+ PROC(INT)BOOL g = is odd;
+ ASSERT (f (40));
+ ASSERT (g (3))
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Nested procedures. #
+BEGIN PROC foo = (INT i) INT:
+ BEGIN PROC bar = (INT i) INT: i - 1;
+ bar (i) * 10
+ END;
+ ASSERT (foo (10) = 90)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC bar = (INT i) INT: i - 1;
+ PROC foo = (INT i) INT:
+ BEGIN
+ bar (i) * 10
+ END;
+ ASSERT (foo (10) = 90)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Identity declarations and procedures. #
+BEGIN PROC foo = (INT i) INT: i + 1;
+ ASSERT (foo (10) = 11);
+ PROC(INT)INT bar = (INT i) INT: i + 1;
+ ASSERT (bar (10) = 11);
+ PROC(INT)INT baz = foo;
+ ASSERT (baz (10) = 11);
+ PROC(INT)INT quux = IF 10 > 1 THEN baz ELSE foo FI;
+ ASSERT (quux (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC foo = (INT i) INT: i + 1;
+ PROC(INT)INT bar;
+ bar := foo;
+ ASSERT (bar (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC foo = (INT i) INT: i + 1;
+ PROC(INT)INT bar := foo;
+ ASSERT (bar (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Call a non-variable procedure before declaration. #
+BEGIN ASSERT (foo = 100);
+ PROC foo = INT: 100;
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC foo := (INT i) INT: i + 1;
+ PROC(INT)INT bar := foo;
+ ASSERT (bar (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# REF REF PROC #
+BEGIN PROC foo = (INT i) INT: i + 1;
+ PROC(INT)INT bar := foo;
+ REF PROC(INT)INT baz;
+ baz := bar;
+ ASSERT (baz (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# REF REF PROC #
+BEGIN PROC foo = (INT i) INT: i + 1;
+ PROC(INT)INT bar := foo;
+ REF PROC(INT)INT baz := bar;
+ ASSERT (baz (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC increment = (INT a) INT: a + 1;
+ PROC getproc = PROC(INT)INT:
+ BEGIN increment
+ END;
+ # getproc below gets deprocedured to yield increment. #
+ ASSERT (getproc (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC increment := (INT a) INT: a + 1;
+ PROC getproc := PROC(INT)INT:
+ BEGIN increment
+ END;
+ # getproc below gets deprocedured to yield increment. #
+ ASSERT (getproc (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC sum = (INT a, b) INT: a + b,
+ minus = (INT a, b) INT: a - b;
+ ASSERT (sum (1, 2) = 3);
+ ASSERT (minus (1, 2) = -1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC reciprocal = (REAL a) REAL: 1/a;
+ REAL x;
+ x := reciprocal (3.14)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC hcf = (INT m, n) INT:
+ IF m < n
+ THEN hcf (n, m)
+ ELIF n = 0
+ THEN m
+ ELSE hcf (n, m MOD n)
+ FI;
+ ASSERT (hcf (10, 20) = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# A heap proc variable. #
+BEGIN HEAP PROC foo := INT: 666;
+ ASSERT (foo = 666)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC foo = (INT i, j) INT: i + j + 1;
+ ASSERT (foo (10, 11) = 22)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (foo (10, 11) = 22);
+ PROC foo = (INT i, j) INT: i + j + 1;
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Recursive function. #
+BEGIN PROC foo = (INT i) INT: (i > 0 | i + foo (i - 1) | 0);
+ ASSERT (foo (10) = 55)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Recursive function, used before declared. #
+BEGIN ASSERT (foo (10) = 55);
+ PROC foo = (INT i) INT: BEGIN (i > 0 | i + foo (i - 1) | 0) END;
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC foo = (INT i) INT: i + 1;
+ PROC(INT)INT bar = foo;
+ ASSERT (bar (10) = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC INT foo = INT: 100;
+ ASSERT (foo = 100)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 4;
+beg: WHILE i > 0
+ DO []PROC VOID table = (l3,l1,l2,end);
+ table[i];
+l1: puts ("uno\n"); i -:= 1; beg;
+l2: puts ("dos\n"); i -:= 1; beg;
+l3: puts ("tres\n"); i -:= 1; beg;
+end: puts ("cuatro\n"); i -:= 1; beg
+ OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+(STRING a="(STRING a="";puts(2*a[:19]+2*a[19:]);0)";puts(2*a[:19]+2*a[19:]))
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN IF random > 0.5 THEN puts ("yes\n") ELSE puts ("no\n") FI;
+ LONG REAL rr = long random;
+ IF rr > LONG 0.5 THEN puts ("long yes\n") ELSE puts ("long no\n") FI;
+ LONG LONG REAL rrr = long long random;
+ IF rrr > LONG LONG 0.5 THEN puts ("long long yes\n") ELSE puts ("long long no\n") FI
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN COMPL z = 4.0I5.0;
+ ASSERT (RE z = 4.0 AND IM z = 5.0);
+ LONG COMPL zz = LONG 4.0 I LONG 6.0;
+ ASSERT (RE zz = LONG 4.0 AND IM zz = LONG 6.0);
+ LONG LONG COMPL zzz = LONG LONG 4.0 I LONG LONG 7.0;
+ ASSERT (RE zzz = LONG LONG 4.0 AND IM zzz = LONG LONG 7.0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT ("" >= "");
+ ASSERT ("" <= "");
+ ASSERT ("zzz" > "aaa");
+ ASSERT ("zzz" >= "aaa");
+ ASSERT ("HelloA" < "HelloB")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (REPR ABS "x" = "x")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN REAL x = 3.14, y = 3.80;
+ LONG REAL xx = LONG 3.14, yy = LONG 3.80;
+ LONG LONG REAL xxx = LONG LONG 3.14, yyy = LONG LONG 3.80;
+ ASSERT (ROUND x = 3 AND ROUND y = 4);
+ ASSERT (ROUND xx = LONG 3 AND ROUND yy = LONG 4);
+ ASSERT (ROUND xxx = LONG LONG 3 AND ROUND yyy = LONG LONG 4)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT foo = (7,8,9);
+ [,]INT bar = ((1,2,3),(4,5,6),foo);
+ ASSERT (bar[1,1] = 1);
+ ASSERT (bar[1,2] = 2);
+ ASSERT (bar[1,3] = 3);
+ ASSERT (bar[2,1] = 4);
+ ASSERT (bar[2,2] = 5);
+ ASSERT (bar[2,3] = 6);
+ ASSERT (bar[3,1] = 7);
+ ASSERT (bar[3,2] = 8);
+ ASSERT (bar[3,3] = 9)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT foo = (7,8,9);
+ [3,3]INT bar := ((1,2,3),(4,5,6),foo);
+ ASSERT (bar[1,1] = 1);
+ ASSERT (bar[1,2] = 2);
+ ASSERT (bar[1,3] = 3);
+ ASSERT (bar[2,1] = 4);
+ ASSERT (bar[2,2] = 5);
+ ASSERT (bar[2,3] = 6);
+ ASSERT (bar[3,1] = 7);
+ ASSERT (bar[3,2] = 8);
+ ASSERT (bar[3,3] = 9)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE FOO = STRUCT (INT i, STRING s);
+ [,]FOO matrix = (((10, "foo"), (20, "bar"), (30, "baz")),
+ ((40, "uno"), (50, "dos"), (60, "tres")),
+ ((70, "cuatro"), (80, "cinco"), (90, "seis")));
+ ASSERT (i OF matrix[1,1] = 10);
+ ASSERT (i OF matrix[1,2] = 20);
+ ASSERT (i OF matrix[1,3] = 30);
+ ASSERT (i OF matrix[2,1] = 40);
+ ASSERT (i OF matrix[2,2] = 50);
+ ASSERT (i OF matrix[2,3] = 60);
+ ASSERT (i OF matrix[3,1] = 70);
+ ASSERT (i OF matrix[3,2] = 80);
+ ASSERT (i OF matrix[3,3] = 90)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,][]INT duples = (((1,2), (3,4), (5,6)),
+ ((7,8), (9,10), (11,12)));
+ ASSERT (duples[1,1][1] = 1);
+ ASSERT (duples[1,1][2] = 2);
+ ASSERT (duples[1,2][1] = 3);
+ ASSERT (duples[1,2][2] = 4);
+ ASSERT (duples[1,3][1] = 5);
+ ASSERT (duples[1,3][2] = 6);
+ ASSERT (duples[2,1][1] = 7);
+ ASSERT (duples[2,1][2] = 8);
+ ASSERT (duples[2,2][1] = 9);
+ ASSERT (duples[2,2][2] = 10);
+ ASSERT (duples[2,3][1] = 11);
+ ASSERT (duples[2,3][2] = 12)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT list1 = (1,2,3),
+ list2 = (4,5,6),
+ list3 = (7,8,9);
+ [,]INT matrix = (list1, list2, list3);
+ [,,]INT cube = (matrix, matrix, matrix);
+ ASSERT (cube[1,1,1] = 1);
+ ASSERT (cube[2,2,2] = 5);
+ ASSERT (cube[3,3,3] = 9)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT a = 10;
+ ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+ ASSERT (a[1] = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 10;
+ REF[,]INT a = i;
+ ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1);
+ ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1);
+ a[1,1] := a[1,1] + 1;
+ ASSERT (a[1,1] = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 10;
+ REF[,,]INT a = i;
+ ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1);
+ ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1);
+ ASSERT (3 LWB a = 1 AND 3 UPB a = 1 AND 3 ELEMS a = 1);
+ a[1,1,1] := a[1,1,1] + 1;
+ ASSERT (a[1,1,1] = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Rowing of NIL yields NIL. #
+BEGIN REF INT i = NIL;
+ REF[]INT a = i;
+ ASSERT (a :=: NIL)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Rowing of NIL yields NIL. #
+BEGIN REF INT i = (NIL);
+ REF[,,]INT a = (i);
+ ASSERT (a :=: NIL)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [][]INT a = 10;
+ ASSERT (a[1][1] = 10);
+ ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+ ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [][][]INT a = 10;
+ ASSERT (a[1][1][1] = 10);
+ ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+ ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1);
+ ASSERT (LWB a[1][1] = 1 AND UPB a[1][1] = 1 AND ELEMS a[1][1] = 1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE FOO = STRUCT (INT i, REAL r);
+ FOO foo = (10, 3.14);
+ [][]FOO a = foo;
+ ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+ ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1);
+ ASSERT (i OF a[1][1] = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Rowing of a name. #
+BEGIN INT i := 10;
+ REF[]INT a = i;
+ ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+ a[1] := a[1] + 1;
+ ASSERT (a[1] = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Rowing of NIL yields NIL. #
+BEGIN REF[]INT a = REF INT(NIL);
+ ASSERT (a :=: NIL)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]INT a = 10;
+ ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1);
+ ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1);
+ ASSERT (a[1,1] = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT a = 10;
+ ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1);
+ [,]INT aa = a;
+ ASSERT (1 LWB aa = 1 AND 1 UPB aa = 1 AND 1 ELEMS aa = 1);
+ ASSERT (2 LWB aa = 1 AND 2 UPB aa = 1 AND 2 ELEMS aa = 1);
+ [,,]INT aaa = aa;
+ ASSERT (1 LWB aaa = 1 AND 1 UPB aaa = 1 AND 1 ELEMS aaa = 1);
+ ASSERT (2 LWB aaa = 1 AND 2 UPB aaa = 1 AND 2 ELEMS aaa = 1);
+ ASSERT (3 LWB aaa = 1 AND 3 UPB aaa = 1 AND 3 ELEMS aaa = 1);
+ ASSERT (aaa[1,1,1] = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,,]INT aaa = 10;
+ ASSERT (1 LWB aaa = 1 AND 1 UPB aaa = 1 AND 1 ELEMS aaa = 1);
+ ASSERT (2 LWB aaa = 1 AND 2 UPB aaa = 1 AND 2 ELEMS aaa = 1);
+ ASSERT (3 LWB aaa = 1 AND 3 UPB aaa = 1 AND 3 ELEMS aaa = 1);
+ ASSERT (aaa[1,1,1] = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Selecting a struct results in a sub-value. #
+BEGIN MODE PERSON = STRUCT (INT age, REAL income, INT num children);
+ PERSON person = (44, 999.99, 0);
+ ASSERT (age OF person = 44);
+ ASSERT (num children OF person = 0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Selecting a struct name results in sub-names. #
+BEGIN MODE PERSON = STRUCT (INT age, REAL income, INT num children);
+ PERSON person;
+ age OF person := 44;
+ income OF person := 999.99;
+ num children OF person := 0;
+ ASSERT (age OF person = 44);
+ ASSERT (num children OF person = 0);
+ REF INT ptr to age := age OF person;
+ ASSERT (ptr to age = 44);
+ age OF person := 55;
+ ASSERT (ptr to age = 55)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Structs can be nested in other structs. #
+BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code);
+ MODE PERSON = STRUCT (INT age, INCOME income, INT num children);
+
+ PERSON person = (44, (999.99, 0.0, 10), 3);
+
+ ASSERT (age OF person = 44);
+ ASSERT (code OF income OF person = 10);
+ ASSERT (num children OF person = 3);
+ ASSERT (num children OF person * code OF income OF person = 30)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Structs can be nested in other structs. Version with subnames. #
+BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code);
+ MODE PERSON = STRUCT (INT age, INCOME income, INT num children);
+
+ PERSON person;
+
+ age OF person := 44;
+ salary OF income OF person := 999.99;
+ stock OF income OF person := 0.0;
+ num children OF person := 3;
+ code OF income OF person := num children OF person;
+
+ ASSERT (age OF person = 44);
+ ASSERT (code OF income OF person = num children OF person);
+ ASSERT (code OF income OF person = 3);
+ ASSERT (num children OF person = 3);
+ ASSERT (num children OF person * code OF income OF person = 9)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# pr UPPER pr #
+BEGIN MODE JORL = STRUCT (INT i, REAL r);
+ REF JORL jorl = LOC JORL := (10, 3.14);
+ ASSERT (i OF jorl = 10)
+END
--- /dev/null
+begin [10]struct (int age, string name) persons;
+
+ for i to UPB persons
+ do age of persons[i] := 20 + i;
+ name of persons[i] := "x" * i
+ od;
+
+ for i to UPB name of persons
+ do assert ((age of persons)[i] = 20 + i);
+ assert ((name of persons)[i] = "x" * i)
+ od
+end
--- /dev/null
+begin [10,5]struct (int age, string name) persons;
+
+ for i to 1 UPB persons
+ do for j to 2 UPB persons
+ do age of persons[i,j] := 20 + i + j;
+ name of persons[i,j] := "x" * (i + j)
+ od
+ od;
+
+ assert (1 UPB name of persons = 10);
+ assert (2 UPB name of persons = 5);
+ for i to 1 UPB name of persons
+ do for j to 2 UPB name of persons
+ do assert ((age of persons)[i,j] = 20 + i + j);
+ assert ((name of persons)[i,j] = "x" * (i + j))
+ od
+ od
+end
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 10;
+ BEGIN INT i = 20; # { dg-warning "hides" } #
+ ASSERT (i = 20);
+ i
+ END;
+ ASSERT (i = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# NIL is not voided and can appear in a context requiring VOID. #
+BEGIN (NIL);
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN BEGIN ASSERT (i = 0);
+ i
+ END;
+ INT i = 10;
+ ASSERT (i = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (i = 0);
+ INT i = 10;
+ ASSERT (i = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i := 10;
+ BEGIN ASSERT (i = 10);
+ i +:= 1
+ END;
+ ASSERT (i = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN BEGIN ASSERT (i = 0);
+ i
+ END;
+ INT i := 10;
+ ASSERT (i = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT ((INT y := 10;
+ INT x := 20;
+ REF INT yy;
+ (REF INT xx := x;
+ yy := y;
+ xx := yy
+ )
+ ) = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT ((INT y := 10;
+ INT x := 20;
+ REF INT yy;
+ (REF INT xx := x;
+ yy := y;
+ xx + yy
+ )
+ ) = 30)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT ((INT y := 10;
+ INT x := 20;
+ REF INT yy;
+ (REF INT xx := x;
+ yy := y;
+ xx
+ )
+ ) = 20)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Serial clause with jump at the end. #
+
+BEGIN INT i := BEGIN BOOL cont := TRUE;
+ back: cont := FALSE;
+ IF cont THEN GOTO back FI
+ END;
+ ASSERT (i = 0)
+END
--- /dev/null
+{ This tests stack management for DSA serial clauses.
+ If it fails a stack overflow happens. }
+begin { DSA due to stack allocated multiple. }
+ to 10000
+ do [10000]int foo;
+ skip
+ od;
+ { DSA due to stack allocated multiple. Explicit loc. }
+ to 10000
+ do loc[10000]int foo;
+ skip
+ od;
+ { DSA due to loc generator. }
+ to 10000
+ do ref[]int jorl = loc [10000]int;
+ skip
+ od
+end
--- /dev/null
+{ Check value yielding of DSA serial clauses. }
+begin assert ((ref int foo = loc int := 100;
+ foo) = 100);
+ []int a = ([10000]int foo; foo[10] := 666; foo);
+ assert (a[10] = 666)
+end
--- /dev/null
+{ The jump to leak should not leak stack. }
+begin by 10000
+ do
+ by 10000
+ do [10000]int foo;
+ skip;
+ goto leak
+ od;
+ leak:
+ skip
+ od
+end
--- /dev/null
+begin (ref int a = loc int := 10; goto leak; a);
+leak:
+ skip
+end
--- /dev/null
+begin assert ((ref int a = loc int := 10; a) + 1 = 11);
+ skip
+end
--- /dev/null
+{ DSA and completers in a serial clause. }
+begin assert ((ref int a = loc int := 10; a exit foo: a +:= 1) + 1 = 11);
+ skip
+end
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT zero = 0;
+ SHORT INT short zero = SHORT 0;
+ SHORT SHORT INT short short zero = SHORT SHORT 0;
+ LONG INT long zero = LONG 0;
+ LONG LONG INT long long zero = LONG LONG 0;
+ INT ten = 10;
+ SHORT INT short ten = SHORT 10;
+ SHORT SHORT INT short short ten = SHORT SHORT 10;
+ LONG INT long ten = LONG 10;
+ LONG LONG INT long long ten = LONG LONG 10;
+ ASSERT (SIGN zero = 0);
+ ASSERT (SIGN short zero = 0);
+ ASSERT (SIGN short short zero = 0);
+ ASSERT (SIGN long zero = 0);
+ ASSERT (SIGN long long zero = 0);
+ ASSERT (SIGN ten = 1);
+ ASSERT (SIGN short ten = 1);
+ ASSERT (SIGN short short ten = 1);
+ ASSERT (SIGN long ten = 1);
+ ASSERT (SIGN long long ten = 1);
+ ASSERT (SIGN -ten = -1);
+ ASSERT (SIGN -short ten = -1);
+ ASSERT (SIGN -short short ten = -1);
+ ASSERT (SIGN -long ten = -1);
+ ASSERT (SIGN -long long ten = -1)
+END
+
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN REAL zero = 0.0;
+ LONG REAL long zero = LONG 0.0;
+ LONG LONG REAL long long zero = LONG LONG 0.0;
+ REAL ten = 10.0;
+ LONG REAL long ten = LONG 10.0;
+ LONG LONG REAL long long ten = LONG LONG 10.0;
+ ASSERT (SIGN zero = 0);
+ ASSERT (SIGN long zero = 0);
+ ASSERT (SIGN long long zero = 0);
+ ASSERT (SIGN ten = 1);
+ ASSERT (SIGN long ten = 1);
+ ASSERT (SIGN long long ten = 1);
+ ASSERT (SIGN -ten = -1);
+ ASSERT (SIGN -long ten = -1);
+ ASSERT (SIGN -long long ten = -1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN REAL r = 0.0;
+ LONG REAL rr = LONG 45.0;
+ LONG LONG REAL rrr = LONG LONG 60.0;
+ ASSERT (sin (r) = 0.0);
+ long sin (rr);
+ long long sin (rrr)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Check SKIPs for INT modes #
+BEGIN INT int skip = SKIP;
+ ASSERT (int skip = 0);
+ SHORT INT short int skip = SKIP;
+ ASSERT (short int skip = SHORT 0);
+ SHORT SHORT INT short short int skip = SKIP;
+ ASSERT (short short int skip = SHORT SHORT 0);
+ LONG INT long int skip = SKIP;
+ ASSERT (long int skip = LONG 0);
+ LONG LONG INT long long int skip = SKIP;
+ ASSERT (long long int skip = LONG LONG 0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Check SKIP values for BOOL and CHAR. #
+BEGIN BOOL bool skip = SKIP;
+ ASSERT (bool skip = FALSE);
+ CHAR char skip = SKIP;
+ ASSERT (char skip = " ")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT jorl);
+ MODE PERSON = STRUCT (INT age, INCOME income, INT num children);
+ PERSON person = SKIP;
+ ASSERT (age OF person = 0);
+ ASSERT (jorl OF income OF person = 0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING foo = "foo";
+ ASSERT (foo[1] = "f");
+ ASSERT (foo[2] = "o");
+ ASSERT (foo[3] = "o");
+ STRING bar := "foo";
+ ASSERT (bar[1] = "f");
+ ASSERT (bar[2] = "o");
+ ASSERT (bar[3] = "o")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT foo = (1,2,3);
+ ASSERT (foo[1] = 1);
+ ASSERT (foo[2] = 2);
+ ASSERT (foo[3] = 3);
+ [3]INT bar := (1,2,3);
+ ASSERT (bar[1] = 1);
+ ASSERT (bar[2] = 2);
+ ASSERT (bar[3] = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT foo = (10,20,30);
+ ASSERT (foo[1] = 10);
+ ASSERT (foo[2] = 20);
+ ASSERT (foo[3] = 30);
+ [3]INT bar := (100,200,300);
+ ASSERT (bar[1] = 100);
+ ASSERT (bar[2] = 200);
+ ASSERT (bar[3] = 300)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE PERSON = STRUCT (INT i, STRING s);
+ []PERSON persons = ((10, "foo"), (20, "barbar"), (30, "baz"));
+ puts (s OF persons[1]);
+ puts (s OF persons[2]);
+ puts (s OF persons[3]);
+ ASSERT (i OF persons[1] = 10);
+ ASSERT (i OF persons[2] = 20);
+ ASSERT (i OF persons[3] = 30)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRUCT([]INT i, REAL r) s = ((1,2,3), 3.14);
+ ASSERT ((i OF s)[1] = 1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT rsp := 5;
+ [10]INT run stack;
+ run stack [(rsp -:= 1) + 1]
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING s := "foo";
+ s[2] := "x"
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN REAL r = 100.0;
+ LONG REAL rr = LONG 25.0;
+ LONG LONG REAL rrr = LONG LONG 25.0;
+ ASSERT (sqrt (r) = 10.0);
+ ASSERT (long sqrt (rr) = LONG 5.0);
+ ASSERT (long long sqrt (rrr) = LONG LONG 5.0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING s = "";
+ ASSERT (LWB s = 1 AND UPB s = 0);
+ STRING t = ();
+ ASSERT (LWB t = 1 AND UPB t = 0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING s;
+ ASSERT (LWB s = 1 AND UPB s = 0 AND ELEMS s = 0);
+ s := "foo";
+ puts (s);
+ ASSERT (LWB s = 1 AND UPB s = 3 AND s[1] = "f" AND s[2] = "o" AND s[3] = "o");
+ s := "bar";
+ puts (s);
+ ASSERT (LWB s = 1 AND UPB s = 3 AND s[1] = "b" AND s[2] = "a" AND s[3] = "r");
+ s := "x";
+ ASSERT (LWB s = 1 AND UPB s = 1 AND s[1] = "x");
+ puts (s)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING s;
+ ASSERT (LWB s = 1 AND UPB s = 0 AND ELEMS s = 0);
+ s +:= "foo";
+ ASSERT (LWB s = 1 AND UPB s = 3 AND ELEMS s = 3)
+END
--- /dev/null
+begin assert (UPB "foo'nbar" = 7 AND "foo'nbar"[4] = REPR 10);
+ assert (UPB "foo'tbar" = 7 AND "foo'tbar"[4] = REPR 9);
+ assert (UPB "foo'rbar" = 7 AND "foo'rbar"[4] = REPR 13);
+ assert (UPB "foo'fbar" = 7 AND "foo'fbar"[4] = REPR 12);
+ assert (UPB "foo''bar" = 7 AND "foo''bar"[4] = REPR 39);
+ assert ("'(u0048,u0065,U0000006c,u006c,U0000006f)" = "Hello");
+ assert ("'( u0048, u0065, U0000006c,u006c, U0000006f )" = "Hello")
+end
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE NODE = STRUCT (INT code, REF NODE next);
+ NODE top;
+ ASSERT (next OF top :=: REF NODE (NIL))
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE NODE = STRUCT (INT code, REF NODE next);
+ NODE top = (20, NIL);
+ ASSERT (code OF top = 20);
+ ASSERT (next OF top :=: NIL)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE NODE = STRUCT (INT code, REF NODE next);
+ NODE top := (10, NIL);
+ NODE next := (20, NIL);
+ next OF top := next;
+ ASSERT (code OF next OF top = 20)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code);
+ MODE PERSON = STRUCT (INT age, INCOME income, INT num children);
+ INCOME income = (100.0, 200.0, 300);
+ ASSERT (code OF income = 300);
+ PERSON person := (24, (1000.0, 2000.0, 3000), 3);
+ ASSERT (code OF income OF person = 3000);
+ ASSERT (num children OF person = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE NODE = STRUCT (INT code, REF INT next);
+ INT val := 20;
+ NODE top = (10, val);
+ ASSERT (val = 20)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE FOO = STRUCT (INT i, REF INT j);
+ INT x := 10;
+ FOO foo;
+ foo := (10, x);
+ ASSERT (j OF foo = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE FOO = STRUCT (INT i, REF INT j);
+ INT x := 10;
+ REF INT xx;
+ FOO foo;
+ foo := (10, xx := x);
+ ASSERT (j OF foo = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE VEC = STRUCT (REAL xcoord, ycoord, zcoord);
+ VEC v1, v2, v3;
+ v1 := (1,1,1);
+ ASSERT (xcoord OF v1 = 1);
+ ASSERT (ycoord OF v1 = 1);
+ ASSERT (zcoord OF v1 = 1);
+ REAL x = 3.14, i = 3;
+ v2 := (x + 2, 3.4, i - 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN REAL r = 0.0;
+ LONG REAL rr = LONG 50.0;
+ LONG LONG REAL rrr = LONG LONG 50.0;
+ ASSERT (tan (r) = 0.0);
+ long tan (rr);
+ long long tan (rrr)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN STRING foo := "foo";
+ foo TIMESAB 1;
+ ASSERT (foo = "foo");
+ foo *:= 3;
+ ASSERT (foo = "foofoofoo")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+ ASSERT (arr[3] = 2 AND arr[4] = 3);
+ []INT jorl = arr[2:3@20];
+ ASSERT (LWB jorl = 20 AND UPB jorl = 21);
+ ASSERT (jorl[20] = 1 AND jorl [21] = 2)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Trimming with flat descriptors should lead to flat multiples. #
+BEGIN []INT a = (1,2,3);
+
+ ASSERT (UPB a[2:1] < LWB a[2:1]);
+ ASSERT (UPB a[20:2] < LWB a[20:2]);
+
+ [,]INT aa = ((1,2,3),
+ (4,5,6),
+ (7,8,9));
+
+ ASSERT ((1 UPB aa[1,2:1]) < ((1 LWB aa[1,2:1])));
+ ASSERT ((1 UPB aa[1,20:]) < ((1 LWB aa[1,20:])))
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+ ASSERT (arr[3] = 2 AND arr[4] = 3);
+ []INT jorl = arr[2:3];
+ ASSERT (LWB jorl = 1 AND UPB jorl = 2);
+ ASSERT (jorl[1] = 1 AND jorl [2] = 2)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+ ASSERT (arr[3] = 2 AND arr[4] = 3);
+ []INT jorl = arr[:@20];
+ ASSERT (LWB jorl = 20 AND UPB jorl = 22);
+ ASSERT (jorl[20] = 1 AND jorl[21] = 2 AND jorl[22] = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+ ASSERT (arr[3] = 2 AND arr[4] = 3);
+ []INT jorl = arr[3:];
+ ASSERT (LWB jorl = 1 AND UPB jorl = 2);
+ ASSERT (jorl[1] = 2 AND jorl[2] = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+ ASSERT (arr[3] = 2 AND arr[4] = 3);
+ []INT jorl = arr[:3 AT 10];
+ ASSERT (LWB jorl = 10 AND UPB jorl = 11);
+ ASSERT (jorl[10] = 1 AND jorl[11] = 2)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+ ASSERT (arr[3] = 2 AND arr[4] = 3);
+ []INT jorl = arr[:3@10];
+ ASSERT (LWB jorl = 10 AND UPB jorl = 11);
+ ASSERT (jorl[10] = 1 AND jorl[11] = 2)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT arr = (1,2,3);
+ ASSERT (arr[2] = 2 AND arr[3] = 3);
+ []INT jorl = arr[2:3@20];
+ ASSERT (LWB jorl = 20 AND UPB jorl = 21);
+ ASSERT (jorl[20] = 2 AND jorl [21] = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+ ASSERT (arr[3] = 2 AND arr[4] = 3);
+ [10:11]INT jorl := arr[:3 AT 10];
+ ASSERT (LWB jorl = 10 AND UPB jorl = 11);
+ ASSERT (jorl[10] = 1 AND jorl[11] = 2);
+ jorl[10] := 100;
+ ASSERT (jorl[10] = 100 AND jorl[11] = 2)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT arr = (1,2,3);
+ ASSERT (arr[2] = 2 AND arr[3] = 3);
+ []INT jorl = arr[@20];
+ ASSERT (LWB jorl = 20 AND UPB jorl = 22);
+ ASSERT (jorl[20] = 1 AND jorl [21] = 2 AND jorl [22] = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]INT matrix = ((1,2,3),
+ (4,5,6),
+ (7,8,9));
+ [2]INT column := matrix[3,2:3];
+ ASSERT (column[1] = 8);
+ ASSERT (column[2] = 9)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]INT matrix = ((1,2,3),
+ (4,5,6),
+ (7,8,9));
+ [2]INT column := matrix[2,1:2];
+ ASSERT (column[1] = 4);
+ ASSERT (column[2] = 5)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]INT matrix = ((1,2,3),
+ (4,5,6),
+ (7,8,9));
+ [3]INT column := matrix[2,1:3];
+ ASSERT (column[1] = 4);
+ ASSERT (column[2] = 5);
+ ASSERT (column[3] = 6)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]INT matrix = ((1,2,3),
+ (4,5,6),
+ (7,8,9));
+ []INT column = matrix[1:3,2];
+ ASSERT (LWB column = 1);
+ ASSERT (UPB column = 3);
+ ASSERT (column[1] = 2 AND column[2] = 5 AND column[3] = 8)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]INT matrix = ((1,2,3),
+ (4,5,6),
+ (7,8,9));
+ []INT column = matrix[2:3,2];
+ ASSERT (LWB column = 1);
+ ASSERT (UPB column = 2);
+ ASSERT (column[1] = 5 AND column[2] = 8)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [,]INT matrix = ((1,2,3),
+ (4,5,6),
+ (7,8,9));
+ []INT row = matrix[3,1:3];
+ ASSERT (LWB row = 1);
+ ASSERT (UPB row = 3);
+ ASSERT (row[1] = 7 AND row[2] = 8 AND row[3] = 9)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN REF[]CHAR t;
+ PROC foo = VOID: (HEAP[3]CHAR ss := ("1","2","3"); t := ss[1:3]);
+ foo;
+ ASSERT (LWB t = 1 AND UPB t = 3);
+ ASSERT (t[1] = "1" AND t[2] = "2" AND t[3] = "3")
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# j's value is undefined (defined to be 0 in GNU Algol) #
+BEGIN INT x := 0;
+ FOR i TO 5
+ DO ASSERT (j = 0);
+ IF j > 20 THEN stop FI;
+ INT j = x + i;
+ x +:= 1
+ OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# The undefined value of the multiple `a' is an empty multiple. #
+BEGIN ASSERT (i = 0);
+ ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0);
+ []INT a = (1, 2, 3);
+ INT i = 10;
+ ASSERT (i = 10);
+ ASSERT (LWB a = 1 AND UPB a = 3 AND ELEMS a = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (sum = 1);
+ PROC sum = INT: i + 1;
+ INT i = 10;
+ ASSERT (sum = 11)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC is even = (INT n) BOOL: (n = zero | TRUE | is odd (n - 1));
+ PROC is odd = (INT n) BOOL: (n = zero | FALSE | is even (n - 1));
+ ASSERT (is even (20));
+ ASSERT (is odd (13));
+ INT zero := 0;
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN PROC is even = (INT n) BOOL: (n = zero | TRUE | is odd (DECR n));
+ PROC is odd = (INT n) BOOL: (n = zero | FALSE | is even (DECR n));
+ OP DECR = (INT a) INT: a - 1;
+ ASSERT (is even (20));
+ ASSERT (is odd (13));
+ INT zero := 0;
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN UNION(INT,REAL,CHAR) datum := 3.14;
+ UNION(INT,REAL,[]INT,CHAR) datux;
+ datux := datum;
+ ASSERT (CASE datux
+ IN (INT): 10,
+ (REAL): 20,
+ (CHAR c): 30
+ ESAC = 20);
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN UNION(INT,REAL,CHAR) datum := "X";
+ UNION(INT,REAL,[]INT,CHAR) datux;
+ datux := datum;
+ ASSERT (CASE datux
+ IN (INT): 10,
+ (REAL): 20,
+ (CHAR c): 30
+ ESAC = 30);
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN UNION(INT,REAL,CHAR) datum := 10;
+ UNION(INT,REAL,[]INT,CHAR) datux;
+ datux := datum;
+ ASSERT (CASE datux
+ IN (INT): 10,
+ (REAL): 20,
+ (CHAR c): 30
+ ESAC = 10);
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# Uniting STRING to ROWS. #
+BEGIN PROC strlen = (STRING s) INT: ELEMS s;
+ ASSERT (strlen ("foo") = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# SHORTEN and LENG on SIZETY BITS #
+BEGIN BITS b = 16rff;
+ ASSERT (b UP 4 = 16rff0);
+ ASSERT (b SHL 4 = 16rff0);
+ ASSERT (b DOWN 4 = 16r0f);
+ ASSERT (b SHR 4 = 16r0f);
+
+ LONG BITS bb = LONG 16rff;
+ ASSERT (bb UP 4 = LONG 16rff0);
+ ASSERT (bb SHL 4 = LONG 16rff0);
+ ASSERT (bb DOWN 4 = LONG 16r0f);
+ ASSERT (bb SHR 4 = LONG 16r0f);
+
+ LONG LONG BITS bbb = LONG LONG 16rff;
+ ASSERT (bbb UP 4 = LONG LONG 16rff0);
+ ASSERT (bbb SHL 4 = LONG LONG 16rff0);
+ ASSERT (bbb DOWN 4 = LONG LONG 16r0f);
+ ASSERT (bbb SHR 4 = LONG LONG 16r0f);
+
+ SHORT BITS ss = SHORT 16rff;
+ ASSERT (ss UP 4 = SHORT 16rff0);
+ ASSERT (ss SHL 4 = SHORT 16rff0);
+ ASSERT (ss DOWN 4 = SHORT 16r0f);
+ ASSERT (ss SHR 4 = SHORT 16r0f);
+
+ SHORT SHORT BITS sss = SHORT SHORT 16r0f;
+ ASSERT (sss UP 4 = SHORT SHORT 16rf0);
+ ASSERT (sss SHL 4 = SHORT SHORT 16rf0);
+ ASSERT (sss DOWN 2 = SHORT SHORT 16r03);
+ ASSERT (sss SHR 2 = SHORT SHORT 16r03)
+END
+
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN ASSERT (UPB "foo" = 3);
+ ASSERT (1 UPB "foo" = 3);
+ ASSERT (UPB "" = 0);
+ ASSERT ((INT i = 1; UPB "") = 0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN []INT a = ();
+ ASSERT (LWB a = 1 AND UPB a = 0)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT x := 10;
+ REF INT xx := x := 20;
+ ASSERT (xx = 20)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT x := 10;
+ REF INT xx := x;
+ ASSERT (xx = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT x := 10;
+ REF INT xx := (x := 20);
+ ASSERT (xx = 20)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT x := 10;
+ REF INT xx := ((x));
+ ASSERT (xx = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT x := 10;
+ REF REF INT xx := LOC REF INT := x := 20;
+ ASSERT (xx = 20)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN MODE FOO = STRUCT (STRING s, INT i);
+ FOO f1 := ("foo", 10);
+ ASSERT (i OF f1 = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN HEAP INT a := 10;
+ ASSERT (a = 10)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN HEAP INT x, y;
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [10,3]INT arr;
+ ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10);
+ ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n = 10;
+ [n,3]INT arr;
+ ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10);
+ ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := 10, m := 3;
+ [n,m]INT arr;
+ ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10);
+ ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := -4, m := 0;
+ [n:m,2]INT arr;
+ ASSERT (1 LWB arr = -4 AND 1 UPB arr = 0 AND 1 ELEMS arr = 5);
+ ASSERT (2 LWB arr = 1 AND 2 UPB arr = 2 AND 2 ELEMS arr = 2)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := -4, m := 0;
+ [n:m,2]INT arr;
+ FOR i FROM 1 LWB arr TO 1 UPB arr
+ DO FOR j FROM 2 LWB arr TO 2 UPB arr
+ DO ASSERT (arr[i,j] = INT(SKIP)) OD
+ OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := -4, m := 0;
+ [n:m,2]REF INT arr;
+ FOR i FROM 1 LWB arr TO 1 UPB arr
+ DO FOR j FROM 2 LWB arr TO 2 UPB arr
+ DO ASSERT (REF INT (arr[i,j]) :=: REF INT(SKIP)) OD
+ OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := 2, m := 3;
+ [n][m]INT arr;
+ FOR i FROM LWB arr TO UPB arr
+ DO FOR j FROM LWB arr[i] TO UPB arr[i]
+ DO ASSERT (arr[i][j] = INT(SKIP)) OD
+ OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT n := -4, m := 0;
+ [10][n:m,2]INT arr;
+ FOR k FROM LWB arr TO UPB arr
+ DO FOR i FROM 1 LWB arr[k] TO 1 UPB arr[k]
+ DO FOR j FROM 2 LWB arr[k] TO 2 UPB arr[k]
+ DO ASSERT (arr[k][i,j] = INT(SKIP)) OD
+ OD
+ OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN [4]INT x, y;
+ SKIP
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i;
+ 2 = i
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN INT i = 10;
+ REAL foo = i;
+ ASSERT (foo > 9.9);
+ ASSERT (foo < 10.1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+BEGIN LONG INT i = LONG 10;
+ LONG REAL foo = i;
+ ASSERT (foo > LONG 9.9);
+ ASSERT (foo < LONG 10.1)
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# XXX use environment enquiry for actual size of BITS #
+BEGIN []BOOL foo = 16rffff;
+ ASSERT (LWB foo = 1 AND UPB foo = 32);
+ FOR i TO 16 DO ASSERT (foo[i] = FALSE) OD;
+ FOR i FROM 17 TO 32 DO ASSERT (foo[i] = TRUE) OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# XXX use environment enquiry for actual size of LONG BITS #
+BEGIN []BOOL foo = LONG 16rffffffff;
+ ASSERT (LWB foo = 1 AND UPB foo = 64);
+ FOR i TO 32 DO ASSERT (foo[i] = FALSE) OD;
+ FOR i FROM 33 TO 64 DO ASSERT (foo[i] = TRUE) OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# XXX use environment enquiry for actual size of LONG LONG BITS #
+BEGIN []BOOL foo = LONG LONG 16rffffffff;
+ ASSERT (LWB foo = 1 AND UPB foo = 64);
+ FOR i TO 32 DO ASSERT (foo[i] = FALSE) OD;
+ FOR i FROM 33 TO 64 DO ASSERT (foo[i] = TRUE) OD
+END
--- /dev/null
+# { dg-options "-fstropping=upper" } #
+# XOR for SIZETY BITS. #
+BEGIN BITS b = 16rf0f0;
+ ASSERT ((b XOR 16r0f0f) = 16rffff);
+ ASSERT ((b XOR 16r00ff) = 16rf00f);
+ LONG BITS bb = LONG 16rf0f0;
+ ASSERT ((bb XOR LONG 16r0f0f) = LONG 16rffff);
+ ASSERT ((bb XOR LONG 16r00ff) = LONG 16rf00f);
+ LONG LONG BITS bbb = LONG LONG 16rf0f0;
+ ASSERT ((bbb XOR LONG LONG 16r0f0f) = LONG LONG 16rffff);
+ ASSERT ((bbb XOR LONG LONG 16r00ff) = LONG LONG 16rf00f);
+ SHORT BITS ss = SHORT 16rf0f0;
+ ASSERT ((ss XOR SHORT 16r0f0f) = SHORT 16rffff);
+ ASSERT ((ss XOR SHORT 16r00ff) = SHORT 16rf00f);
+ SHORT SHORT BITS sss = SHORT SHORT 16rf0;
+ ASSERT ((sss XOR SHORT SHORT 16r0f) = SHORT SHORT 16rff);
+ ASSERT ((sss XOR SHORT SHORT 16rff) = SHORT SHORT 16r0f)
+END
projects / thirdparty / gcc.git / commitdiff
