a68: testsuite: compilation tests

Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>

gcc/testsuite/ChangeLog

	* algol68/compile/a68includes/goodbye-supper.a68
	* algol68/compile/a68includes/goodbye.a68: Likewise.
	* algol68/compile/a68includes/hello-supper.a68: Likewise.
	* algol68/compile/a68includes/hello.a68: Likewise.
	* algol68/compile/actual-bounds-expected-1.a68: Likewise.
	* algol68/compile/actual-bounds-expected-2.a68: Likewise.
	* algol68/compile/actual-bounds-expected-3.a68: Likewise.
	* algol68/compile/balancing-1.a68: Likewise.
	* algol68/compile/bold-nestable-comment-1.a68: Likewise.
	* algol68/compile/bold-taggle-1.a68: Likewise.
	* algol68/compile/brief-nestable-comment-1.a68: Likewise.
	* algol68/compile/brief-nestable-comment-2.a68: Likewise.
	* algol68/compile/char-break-1.a68: Likewise.
	* algol68/compile/compile.exp: Likewise.
	* algol68/compile/conditional-clause-1.a68: Likewise.
	* algol68/compile/error-bold-taggle-1.a68: Likewise.
	* algol68/compile/error-coercion-1.a68: Likewise.
	* algol68/compile/error-coercion-2.a68: Likewise.
	* algol68/compile/error-coercion-flex-1.a68: Likewise.
	* algol68/compile/error-conformance-clause-1.a68: Likewise.
	* algol68/compile/error-contraction-1.a68: Likewise.
	* algol68/compile/error-contraction-2.a68: Likewise.
	* algol68/compile/error-incestuous-union-1.a68: Likewise.
	* algol68/compile/error-label-after-decl-1.a68: Likewise.
	* algol68/compile/error-nestable-comments-1.a68: Likewise.
	* algol68/compile/error-nested-comment-1.a68: Likewise.
	* algol68/compile/error-no-bounds-allowed-1.a68: Likewise.
	* algol68/compile/error-string-break-1.a68: Likewise.
	* algol68/compile/error-string-break-2.a68: Likewise.
	* algol68/compile/error-string-break-3.a68: Likewise.
	* algol68/compile/error-string-break-4.a68: Likewise.
	* algol68/compile/error-string-break-5.a68: Likewise.
	* algol68/compile/error-string-break-6.a68: Likewise.
	* algol68/compile/error-string-break-7.a68: Likewise.
	* algol68/compile/error-supper-1.a68: Likewise.
	* algol68/compile/error-supper-2.a68: Likewise.
	* algol68/compile/error-supper-3.a68: Likewise.
	* algol68/compile/error-supper-4.a68: Likewise.
	* algol68/compile/error-supper-5.a68: Likewise.
	* algol68/compile/error-supper-6.a68: Likewise.
	* algol68/compile/error-underscore-in-mode-1.a68: Likewise.
	* algol68/compile/error-underscore-in-tag-1.a68: Likewise.
	* algol68/compile/error-upper-1.a68: Likewise.
	* algol68/compile/error-widening-1.a68: Likewise.
	* algol68/compile/error-widening-2.a68: Likewise.
	* algol68/compile/error-widening-3.a68: Likewise.
	* algol68/compile/error-widening-4.a68: Likewise.
	* algol68/compile/error-widening-5.a68: Likewise.
	* algol68/compile/error-widening-6.a68: Likewise.
	* algol68/compile/error-widening-7.a68: Likewise.
	* algol68/compile/error-widening-8.a68: Likewise.
	* algol68/compile/error-widening-9.a68: Likewise.
	* algol68/compile/hidden-operators-1.a68: Likewise.
	* algol68/compile/implicit-widening-1.a68: Likewise.
	* algol68/compile/include-supper.a68: Likewise.
	* algol68/compile/include.a68: Likewise.
	* algol68/compile/labeled-unit-1.a68: Likewise.
	* algol68/compile/nested-comment-1.a68: Likewise.
	* algol68/compile/nested-comment-2.a68: Likewise.
	* algol68/compile/operators-firmly-related.a68: Likewise.
	* algol68/compile/recursive-modes-1.a68: Likewise.
	* algol68/compile/recursive-modes-2.a68: Likewise.
	* algol68/compile/serial-clause-jump-1.a68: Likewise.
	* algol68/compile/snobol.a68: Likewise.
	* algol68/compile/supper-1.a68: Likewise.
	* algol68/compile/supper-10.a68: Likewise.
	* algol68/compile/supper-11.a68: Likewise.
	* algol68/compile/supper-12.a68: Likewise.
	* algol68/compile/supper-13.a68: Likewise.
	* algol68/compile/supper-2.a68: Likewise.
	* algol68/compile/supper-3.a68: Likewise.
	* algol68/compile/supper-4.a68: Likewise.
	* algol68/compile/supper-5.a68: Likewise.
	* algol68/compile/supper-6.a68: Likewise.
	* algol68/compile/supper-7.a68: Likewise.
	* algol68/compile/supper-8.a68: Likewise.
	* algol68/compile/supper-9.a68: Likewise.
	* algol68/compile/uniting-1.a68: Likewise.
	* algol68/compile/upper-1.a68: Likewise.
	* algol68/compile/warning-scope-1.a68: Likewise.
	* algol68/compile/warning-scope-2.a68: Likewise.
	* algol68/compile/warning-scope-3.a68: Likewise.
	* algol68/compile/warning-scope-4.a68: Likewise.
	* algol68/compile/warning-scope-5.a68: Likewise.
	* algol68/compile/warning-scope-6.a68: Likewise.
	* algol68/compile/warning-scope-7.a68: Likewise.
	* algol68/compile/warning-voiding-1.a68: Likewise.
	* algol68/compile/warning-voiding-2.a68: Likewise.

gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68

@@ -0,0 +1,4 @@
+proc goodbye = (string name) string:
+begin string msg := "Goodbye " + name;
+      msg
+end;

gcc/testsuite/algol68/compile/a68includes/goodbye.a68

@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# PR UPPER PR #
+
+PROC goodbye = (STRING name) STRING:
+BEGIN
+    STRING msg := "Goodbye " + name;
+    msg
+END;

gcc/testsuite/algol68/compile/a68includes/hello-supper.a68

@@ -0,0 +1,5 @@
+proc hello = (string name) string:
+begin string msg := "Hello " + name;
+      msg
+end;
+

gcc/testsuite/algol68/compile/a68includes/hello.a68

@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# PR UPPER PR #
+
+PROC hello = (STRING name) STRING:
+BEGIN
+    STRING msg := "Hello " + name;
+    msg
+END;

gcc/testsuite/algol68/compile/actual-bounds-expected-1.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT a := (1,2,3); # { dg-error "actual bounds expected" }  #
+      SKIP
+END

gcc/testsuite/algol68/compile/actual-bounds-expected-2.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN LOC[]INT a := (1,2,3); # { dg-error "actual bounds expected" }  #
+      SKIP
+END

gcc/testsuite/algol68/compile/actual-bounds-expected-3.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN LOC[]INT a := (1,2,3), # { dg-error "actual bounds expected" }  #
+               b := (4);
+      SKIP
+END

gcc/testsuite/algol68/compile/balancing-1.a68

@@ -0,0 +1,7 @@
+mode Word = union (void,real),
+     Rules = union (void,string);
+
+op LEN = (Word w) int: skip,
+LEN = (Rules r) int: skip;
+
+skip

gcc/testsuite/algol68/compile/bold-nestable-comment-1.a68

@@ -0,0 +1,7 @@
+# { dg-options {-fstropping=upper} }  #
+# pr UPPER pr  #
+BEGIN NOTE This is a
+           NOTE nestable ETON comment in bold style.
+      ETON
+      SKIP
+END

gcc/testsuite/algol68/compile/bold-taggle-1.a68

@@ -0,0 +1,6 @@
+# { dg-options {-std=gnu68 -fstropping=upper} }  #
+
+BEGIN MODE FOO_BAR = INT;
+      FOO_BAR foo_bar = 10;
+      SKIP
+END

gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68

@@ -0,0 +1,4 @@
+begin { This is a
+        { nestable } comment in brief style.  }
+      skip
+end

gcc/testsuite/algol68/compile/brief-nestable-comment-2.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN NOTE This is a
+        { nestable } comment in brief style.
+      ETON
+      SKIP
+END

gcc/testsuite/algol68/compile/char-break-1.a68

@@ -0,0 +1,11 @@
+{ Make sure char denotations with string breaks work.  }
+begin prio % = 9;
+      op % = (char a) char: a;
+      assert (ABS %"'n" = 10);
+      assert (ABS %"'f" = 12);
+      assert (ABS %"'t" = 9);
+      assert (ABS %"'r" = 13);
+      assert (%"'(  u0061)" = "a");
+      assert (%"'(U00000061  )" = "a");
+      assert (%"'(u1234)" = replacement_char)
+end

gcc/testsuite/algol68/compile/compile.exp

@@ -0,0 +1,34 @@
+# Copyright (C) 2024 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# 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/>.
+
+# Compile tests, no torture testing.
+#
+# These tests raise errors in the front end; torture testing doesn't apply.
+
+load_lib algol68-dg.exp
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+set saved-dg-do-what-default ${dg-do-what-default}
+
+set dg-do-what-default "compile"
+algol68-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] "" ""
+set dg-do-what-default ${saved-dg-do-what-default}
+
+# All done.
+dg-finish

gcc/testsuite/algol68/compile/conditional-clause-1.a68

@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT i := 26;
+      IF INT ii = i * 2; ii > 50 THEN
+         ii
+      ELIF i = 10 THEN
+         100
+      FI
+END

gcc/testsuite/algol68/compile/error-bold-taggle-1.a68

@@ -0,0 +1,6 @@
+# { dg-options {-std=algol68 -fstropping=upper} }  #
+
+BEGIN MODE FOO_BAR = INT; # { dg-error "unworthy" }  #
+      FOO_BAR foo_bar = 10;
+      SKIP
+END

gcc/testsuite/algol68/compile/error-coercion-1.a68

@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT a;
+      a := "foo" # { dg-error "cannot be coerced" } #
+END

gcc/testsuite/algol68/compile/error-coercion-2.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+# This is Example 4.2.6c in McGETTRICK[78].  #
+BEGIN []STRUCT([]INT a) r = (1,2,3); # { dg-error "cannot be coerced" } #
+      SKIP
+END

gcc/testsuite/algol68/compile/error-coercion-flex-1.a68

@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Coercing from REF FLEX[]REAL to REF[]REAL is not allowed, since
+  flexibility shall match #
+BEGIN FLEX[1:0] REAL rowvar := SKIP;
+      REF [] REAL xlm = rowvar; # { dg-error "FLEX.*cannot be coerced" }  #
+      SKIP
+END

gcc/testsuite/algol68/compile/error-compile-unknown-tag-1.a68

@@ -0,0 +1,8 @@
+module Foo = def pub int idpublic = 10;
+                 int idprivate = 20;
+                 skip
+             fed,
+       Bar = def pub int idpublic = 30;
+                 int idprivate = 40;
+                 xxx { dg-error "" }
+             fed

gcc/testsuite/algol68/compile/error-conformance-clause-1.a68

@@ -0,0 +1,8 @@
+{ This is an invalid program.  }
+begin case
+           if true then "foo" else 10 fi { dg-error "not a united mode" }
+      in (string): skip,
+         (int): skip
+      esac
+end
+   

gcc/testsuite/algol68/compile/error-contraction-1.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Contracting mixed collateral variable and constant declarations is
+  not allowed.
+#
+(INT foo = 100, bar := 200) # { dg-error "mixed" } #

gcc/testsuite/algol68/compile/error-contraction-2.a68

@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Contracting mixed collateral variable and constant declarations is
+  not allowed.  #
+BEGIN PROC x = VOID: SKIP,
+      y := VOID: SKIP; # { dg-error "mixed" } #
+      x
+END

gcc/testsuite/algol68/compile/error-def-1.a68

@@ -0,0 +1,3 @@
+module Foo =
+def skip; { dg-error "fed" }
+    skip

gcc/testsuite/algol68/compile/error-incestuous-union-1.a68

@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Union modes shall not contain modes which are firmly related, i.e.
+  it shall not be possible to coerce from one mode to another in a
+  firm context. #
+BEGIN UNION(INT, REF INT) incestuous; # { dg-error "has firmly related components" } #
+      incestuous
+END

gcc/testsuite/algol68/compile/error-label-after-decl-1.a68

@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN GOTO end;
+      ASSERT(FALSE);
+end:  0;
+      INT i = 10; # { dg-error "declaration cannot follow" }  #
+      i
+END

gcc/testsuite/algol68/compile/error-mode-stropping-1.a68

@@ -0,0 +1,3 @@
+begin struct (int i, real r) j;
+      j := "joo" { dg-error "char.*struct \\(int i, real r\\)" }
+end

gcc/testsuite/algol68/compile/error-mode-stropping-10.a68

@@ -0,0 +1,3 @@
+begin long long int j;
+      j := "joo" { dg-error "char.*long long int" }
+end

gcc/testsuite/algol68/compile/error-mode-stropping-11.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN LONG LONG INT j;
+      j := "joo" { dg-error "CHAR.*LONG LONG INT" }
+END

gcc/testsuite/algol68/compile/error-mode-stropping-12.a68

@@ -0,0 +1,3 @@
+begin short int j;
+      j := "joo" { dg-error "char.*short int" }
+end

gcc/testsuite/algol68/compile/error-mode-stropping-13.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN SHORT INT j;
+      j := "joo" { dg-error "CHAR.*SHORT INT" }
+END

gcc/testsuite/algol68/compile/error-mode-stropping-14.a68

@@ -0,0 +1,3 @@
+begin short short int j;
+      j := "joo" { dg-error "char.*short short int" }
+end

gcc/testsuite/algol68/compile/error-mode-stropping-15.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN SHORT SHORT INT j;
+      j := "joo" { dg-error "CHAR.*SHORT SHORT INT" }
+END

gcc/testsuite/algol68/compile/error-mode-stropping-16.a68

@@ -0,0 +1,3 @@
+begin flex[1:0]int j;
+      j := "joo" { dg-error "char.*flex.*int" }
+end

gcc/testsuite/algol68/compile/error-mode-stropping-17.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" } #
+BEGIN FLEX[1:0]INT j;
+      j := "joo" { dg-error "CHAR.*FLEX.*INT" }
+END

gcc/testsuite/algol68/compile/error-mode-stropping-2.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRUCT (INT i, REAL r) j;
+      j := "joo" # { dg-error "CHAR.*STRUCT \\(INT i, REAL r\\)" } #
+END

gcc/testsuite/algol68/compile/error-mode-stropping-3.a68

@@ -0,0 +1,3 @@
+begin union (int,real) j;
+      j := "joo" { dg-error "char.*union \\( *real *, *int *\\)" }
+end

gcc/testsuite/algol68/compile/error-mode-stropping-4.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN UNION (INT,REAL) j;
+      j := "joo" { dg-error "CHAR.*UNION \\( *REAL *, *INT *\\)" }
+END

gcc/testsuite/algol68/compile/error-mode-stropping-5.a68

@@ -0,0 +1,3 @@
+begin proc union (int,real) j;
+      j := "joo" { dg-error "char.*proc union \\( *real *, *int *\\)" }
+end

gcc/testsuite/algol68/compile/error-mode-stropping-6.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC UNION (INT,REAL) j;
+      j := "joo" { dg-error "CHAR.*PROC UNION \\( *REAL *, *INT *\\)" }
+END

gcc/testsuite/algol68/compile/error-mode-stropping-8.a68

@@ -0,0 +1,3 @@
+begin long int j;
+      j := "joo" { dg-error "char.*long int" }
+end

gcc/testsuite/algol68/compile/error-mode-stropping-9.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN LONG INT j;
+      j := "joo" { dg-error "CHAR.*LONG INT" }
+END

gcc/testsuite/algol68/compile/error-module-coercions-1.a68

@@ -0,0 +1,15 @@
+{ This test makes sure mode checks are carried
+  over the inside of module texts. }
+module Foo = def
+                skip
+             postlude
+                int i = "foo"; { dg-error "coerced" }
+                skip
+             fed,
+       Bar = def
+                int i = 3.14; { dg-error "coerced" }
+                skip
+             postlude
+                skip
+             fed,
+       Baz = def skip fed

gcc/testsuite/algol68/compile/error-module-not-found-1.a68

@@ -0,0 +1,4 @@
+access
+       Foo { dg-error "cannot find module" }
+begin skip end
+      

gcc/testsuite/algol68/compile/error-module-ranges-1.a68

@@ -0,0 +1,13 @@
+{ Definitions in the def-part of a module text are visible in the
+  postlude-part, but not the other way around.  }
+
+module Foo = def int i;
+                 x := 20 { dg-error "" }
+             postlude
+                 i := 10 { this is ok }
+             fed,
+       Bar = def int x;
+                 skip
+             postlude
+                 x := 20 { this is ok }
+             fed

gcc/testsuite/algol68/compile/error-nestable-comments-1.a68

@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" } #
+# pr UPPER pr  #
+BEGIN NOTE This is a
+        NOTE nestable ETON comment in brief style.
+      ETON
+      { Another { comment }.  }
+      NOTE invalid { nesting ETON of comments } # { dg-error "" }  #
+      SKIP
+END

gcc/testsuite/algol68/compile/error-nested-comment-1.a68

@@ -0,0 +1,6 @@
+{ The string in nested comment is in one logical line.  }
+begin
+      { puts ("{'n { dg-error {} }
+"); { this prints foo }}
+      skip
+end

gcc/testsuite/algol68/compile/error-no-bounds-allowed-1.a68

@@ -0,0 +1,15 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN [1:10]INT i,
+      [1:10]STRUCT(REF[]INT i, BOOL j) k,
+      [1:10]STRUCT([1:10]INT i, BOOL j) l,
+      [1:10]REF[]INT p;
+      # formal, so no bounds allowed:  #
+      [1:10]PROC[1:10]INT q, # { dg-error "formal bounds expected" }  #
+      STRUCT(REF[1:10]INT i, BOOLj) m, # { dg-error "virtual bounds expected" }  #
+      [1:10]REF[1:10]INT mn, # { dg-error "virtual bounds expected" }  #
+      PROC([1:10]INT)VOID pp, # { dg-error "formal bounds expected" }  #
+      UNION([1:10] INT, BOOL) nm, # { dg-error "formal bounds expected" }  #
+      [1:10]INT u = (1); # { dg-error "formal bounds expected" }  #
+      SKIP
+END

gcc/testsuite/algol68/compile/error-pragmat-1.a68

@@ -0,0 +1,8 @@
+{ dg-error "unrecognized pragmat" } pr invalid Foo in "module" pr
+
+begin prio // = 8;
+      op (int,int)int // = lala;
+      proc lala = (int a, b) int: a + b;
+      proc void jeje = skip;
+      skip
+end

gcc/testsuite/algol68/compile/error-pragmat-access-1.a68

@@ -0,0 +1,8 @@
+pr access Foo in  pr { dg-error "expected string" } 
+
+begin prio // = 8;
+      op (int,int)int // = lala;
+      proc lala = (int a, b) int: a + b;
+      proc void jeje = skip;
+      skip
+end

gcc/testsuite/algol68/compile/error-pragmat-access-2.a68

@@ -0,0 +1,9 @@
+pr access Foo in "lala" pr
+pr access Foo in "lele" pr { dg-error "multiple" } 
+
+begin prio // = 8;
+      op (int,int)int // = lala;
+      proc lala = (int a, b) int: a + b;
+      proc void jeje = skip;
+      skip
+end

gcc/testsuite/algol68/compile/error-pub-loc-1.a68

@@ -0,0 +1,10 @@
+{ Publicized varifables cannot go on the stack, for obvious reasons.  }
+
+module Foo =
+def
+    pub string xx;
+    pub heap string yy;
+    pub loc string zz; { dg-error "" }
+    loc string vv;
+    skip
+fed

gcc/testsuite/algol68/compile/error-pub-out-of-def-1.a68

@@ -0,0 +1,13 @@
+module Foo =
+def pub mode JORL = int;
+    pub proc plus = (int a, b) int: a + b;
+    pub proc vplus := (int a, b) int: a + b;
+    pub loc proc lvplus := (int a, b) int: a + b;
+    pub heap proc hvplus := (int a, b) int: a + b;
+    pub prio // = 8;
+    pub op // = (int a, b) int: a % b;
+    proc invalid = void:
+       (pub mode JI = void;  { dg-error "" }
+        skip);
+    skip
+fed

gcc/testsuite/algol68/compile/error-pub-out-of-def-2.a68

@@ -0,0 +1,9 @@
+begin pub mode Jorl = void; { dg-error "" }
+      pub proc lala = void: skip; { dg-error "" }
+      pub proc lele := void: skip; { dg-error "" }
+      begin pub prio + = 4; { dg-error "" }
+            skip
+      end;
+      pub op // = (int a, b) int: a % b; { dg-error "" }
+      skip
+end

gcc/testsuite/algol68/compile/error-string-break-1.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN puts ("hello '_ world") # { dg-error "invalid string break sequence" }  #
+END

gcc/testsuite/algol68/compile/error-string-break-2.a68

@@ -0,0 +1,2 @@
+begin puts ("hello '(U0000) world") # { dg-error "eight" }  #
+end

gcc/testsuite/algol68/compile/error-string-break-3.a68

@@ -0,0 +1,2 @@
+begin puts ("hello '(u00) world") # { dg-error "four" }  #
+end

gcc/testsuite/algol68/compile/error-string-break-4.a68

@@ -0,0 +1,2 @@
+begin puts ("hello '(u) world") # { dg-error "four" }  #
+end

gcc/testsuite/algol68/compile/error-string-break-5.a68

@@ -0,0 +1,2 @@
+begin puts ("hello '(u0010u0020) world") # { dg-error "" }  #
+end

gcc/testsuite/algol68/compile/error-string-break-6.a68

@@ -0,0 +1,2 @@
+begin puts ("hello '(u0010'/) world") # { dg-error "" }  #
+end

gcc/testsuite/algol68/compile/error-string-break-7.a68

@@ -0,0 +1,2 @@
+begin puts ("'") # { dg-error "" }  #
+end

gcc/testsuite/algol68/compile/error-string-break-8.a68

@@ -0,0 +1,4 @@
+begin string s =
+         "'(Uf09f94a5)"; { dg-error "Unicode" }
+      skip
+end

gcc/testsuite/algol68/compile/error-stropping-5.a68

@@ -0,0 +1,3 @@
+begin int j;
+      j := "joo" { dg-error "char.*int" }
+end

gcc/testsuite/algol68/compile/error-stropping-6.a68

@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" } #
+BEGIN INT j;
+      j := "joo" # { dg-error "CHAR.*INT" } #
+END

gcc/testsuite/algol68/compile/error-stropping-keyword-1.a68

@@ -0,0 +1,2 @@
+begin for i to 10 skip od { dg-error "do" }
+end

gcc/testsuite/algol68/compile/error-stropping-keyword-2.a68

@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" } #
+BEGIN FOR i TO 10 SKIP OD # { dg-error "DO" } #
+END

gcc/testsuite/algol68/compile/error-stropping-keyword-3.a68

@@ -0,0 +1,2 @@
+begin if then 10 else 20 fi { dg-error "if" }
+end

gcc/testsuite/algol68/compile/error-stropping-keyword-4.a68

@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN IF THEN 10 ELSE 20 FI # { dg-error "IF" } #
+END

gcc/testsuite/algol68/compile/error-supper-1.a68

@@ -0,0 +1,3 @@
+# { dg-options {-fstropping=upper} }  #
+
+begin ~ end # { dg-error "" }  #

gcc/testsuite/algol68/compile/error-supper-2.a68

@@ -0,0 +1,5 @@
+# { dg-options {-fstropping=supper} }  #
+
+begin int foo__bar = 10; # { dg-error "unworthy" }  #
+      skip
+end

gcc/testsuite/algol68/compile/error-supper-3.a68

@@ -0,0 +1,5 @@
+# { dg-options {-fstropping=supper} }  #
+
+begin int _bar = 10; # { dg-error "unworthy" }  #
+      skip
+end

gcc/testsuite/algol68/compile/error-supper-4.a68

@@ -0,0 +1,5 @@
+{ dg-options {-fstropping=supper} }
+
+begin int foo bar = 10; { dg-error "" }
+      skip
+end

gcc/testsuite/algol68/compile/error-supper-5.a68

@@ -0,0 +1,5 @@
+# { dg-options {-fstropping=supper} }  #
+
+begin int foo__ = 10; # { dg-error "unworthy" }  #
+      skip
+end

gcc/testsuite/algol68/compile/error-supper-6.a68

@@ -0,0 +1,6 @@
+# { dg-options {-fstropping=supper} }  #
+
+begin mode foo_Invalid = int; # { dg-error "Invalid" }  #
+      foo_Invalid some_int = 10; # { dg-error "Invalid" }  #
+      skip
+end

gcc/testsuite/algol68/compile/error-underscore-in-mode-1.a68

@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Underscores are unworthy characters if they are not trailing
+  either a taggle or, in UPPER stropping, a bold word.  #
+BEGIN INT invalid_tag__; # { dg-error "unworthy character" } #
+      SKIP
+END

gcc/testsuite/algol68/compile/error-underscore-in-tag-1.a68

@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Underscores are unworthy characters if they are not trailing a
+  taggle or, in UPPER stropping, a bold word..  #
+BEGIN MODE INVALID_BOLD_WORD__; # { dg-error "unworthy character" } #
+      SKIP
+END

gcc/testsuite/algol68/compile/error-upper-1.a68

@@ -0,0 +1,3 @@
+# { dg-options {-fstropping=supper} }  #
+
+BEGIN ~ END # { dg-error "" }  #

gcc/testsuite/algol68/compile/error-vacuum-1.a68

@@ -0,0 +1,2 @@
+begin { dg-error "" }
+end

gcc/testsuite/algol68/compile/error-vacuum-2.a68

@@ -0,0 +1,2 @@
+( { dg-error "" }
+)

gcc/testsuite/algol68/compile/error-vacuum-3.a68

@@ -0,0 +1,3 @@
+begin struct(int i, real r) foo = (); { dg-error "" }
+      skip
+end

gcc/testsuite/algol68/compile/error-widening-1.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT a := 10;
+      LONG REAL l := a; # { dg-error "coerced" } #
+      l
+END

gcc/testsuite/algol68/compile/error-widening-2.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT a := 10;
+      LONG INT l := a; # { dg-error "coerced" } #
+      l
+END

gcc/testsuite/algol68/compile/error-widening-3.a68

@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT d := 0;
+      INT y := 10;
+      LONG REAL x;
+      2
+        + (d > 0 | x | # { dg-error "" }  #
+           y
+          )
+END

gcc/testsuite/algol68/compile/error-widening-4.a68

@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   INT d := 0;
+   LONG REAL x;
+   2
+     + (d > 0 | x | # { dg-error "" }  #
+          10
+       )
+END

gcc/testsuite/algol68/compile/error-widening-5.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   LONG INT d := 0; # { dg-error "coerced" }  #
+   d
+END

gcc/testsuite/algol68/compile/error-widening-6.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   LONG LONG INT d := LONG 0; # { dg-error "coerced" }  #
+   d
+END

gcc/testsuite/algol68/compile/error-widening-7.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   LONG REAL d := 3.14; # { dg-error "coerced" }  #
+   d
+END

gcc/testsuite/algol68/compile/error-widening-8.a68

@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   LONG LONG REAL d := LONG 3.14; # { dg-error "coerced" }  #
+   d
+END

gcc/testsuite/algol68/compile/error-widening-9.a68

@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   INT d := 0;
+   LONG LONG REAL x;
+   2
+     + (d > 0 | x | # { dg-error "" }  #
+          10
+       )
+END

gcc/testsuite/algol68/compile/hidden-operators-1.a68

@@ -0,0 +1,11 @@
+{ dg-options {-Whidden-declarations} }
+
+begin mode Trilean = union (void,bool);
+
+      Trilean unknown = empty;
+      op NOT = (Trilean a) Trilean: { dg-warning "hides" }
+         skip;
+      op AND = (Trilean a,b) Trilean: { dg-warning "hides" }
+         skip;
+      skip
+end

gcc/testsuite/algol68/compile/implicit-widening-1.a68

@@ -0,0 +1,10 @@
+# { dg-options "-Wextensions -fstropping=upper" }  #
+
+# This program shall compile without warning, because
+  widening from INT to REAL is legal in the strict language,
+  since they have the same size.  #
+
+BEGIN BOOL cond;
+      REAL x, y;
+      y + (cond | x | 10)
+END

gcc/testsuite/algol68/compile/include-supper.a68

@@ -0,0 +1,16 @@
+{ dg-options "-I$srcdir/algol68/compile/a68includes" }
+{ dg-additional-files "$srcdir/algol68/compile/a68includes/hello-supper.a68 $srcdir/algol68/compile/a68includes/goodbye-supper.a68" }
+
+begin string name := "Algol68 with supper!";
+      { Both files are in `./a68includes'.
+        The first one will be included because we uwed `-I.
+        The second one will be included because of the relative path. }
+      pr include "hello-supper.a68" pr
+      pr include "a68includes/goodbye-supper.a68" pr
+
+      string bye := goodbye(name);
+      string hi := hello(name);
+
+      puts(hi + "\n");
+      puts(bye  + "\n")
+end

gcc/testsuite/algol68/compile/include.a68

@@ -0,0 +1,19 @@
+# { dg-options "-I$srcdir/algol68/compile/a68includes -fstropping=upper" } #
+# { dg-additional-files "$srcdir/algol68/compile/a68includes/hello.a68 $srcdir/algol68/compile/a68includes/goodbye.a68" } #
+
+# PR UPPER PR  #
+
+BEGIN STRING name := "Algol68!";
+      # Both files are in `./a68includes'.
+        The first one will be included because we used `-I'.
+        The second one will be included because of the relative path.
+      #
+      PR include "hello.a68" PR
+      PR include "a68includes/goodbye.a68" PR
+
+      STRING bye := goodbye(name);
+      STRING hi := hello(name);
+
+      puts(hi + "\n");
+      puts(bye  + "\n")
+END

gcc/testsuite/algol68/compile/labeled-unit-1.a68

@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+# This tests that the mode of the value yielded by a labeled unit is
+  the mode of the unit.  #
+BEGIN 10;
+jorl: 20
+END

gcc/testsuite/algol68/compile/module-1.a68

@@ -0,0 +1,69 @@
+module Argp =
+def mode ArgOpt = struct (char name, string long_name,
+                          bool arg_required, proc(string)bool handler);
+
+    proc argp = (int p, [][]ArgOpt opts,
+                 proc(int,string)bool no_opt_handler,
+                 proc(string)void error_handler) void:
+    begin
+          proc getopt = (string prefix, string arg) ArgOpt:
+          begin ArgOpt res, bool found := false;
+                for i to UPB opts while NOT found
+                do for j to UPB opts[i] while NOT found
+                   do if arg = long_name of opts[i][j]
+                         OR (arg /= " " AND arg = name of opts[i][j])
+                      then res := opts[i][j]; found := true
+                      fi
+                   od
+                od;
+                (NOT found | error_handler ("unknown option " + prefix + arg));
+                res
+          end;
+
+          bool found_dash_dash := false,
+               skip_next_opt := false,
+               continue := true;
+
+          for i from p to argc while continue
+          do string arg = argv (i);
+             if skip_next_opt
+             then skip_next_opt := false
+             elif arg = "--" AND NOT found_dash_dash
+             then found_dash_dash := true
+             elif found_dash_dash OR (UPB arg >= 1 andth arg[1] /= "-")
+             then continue := no_opt_handler (i + 1, arg)
+             elif UPB arg > 1 andth arg[2] = "-"
+             then { Long option.  It may have an argument.  }
+                  int eqidx = char_in_string (arg, "=");
+                  string optname = (eqidx > 0 | arg[3:eqidx - 1] | arg[3:]),
+                  optarg = (eqidx > 0 AND UPB arg >= (eqidx + 1) | arg[eqidx + 1:]);
+                  ArgOpt opt = getopt ("--", optname);
+
+                  if (arg_required of opt) AND optarg = ""
+                  then error_handler ("option --" + arg + " requires an argument") fi;
+                  continue := (handler of opt) (optarg)
+             else { This is one or more short options.  }
+                  for j to UPB arg[2:]
+                  do ArgOpt opt = getopt ("-", arg[j + 1]);
+                     if arg_required of opt
+                     then if i = argc orel (ELEMS argv (i + 1) > 1 andth argv (i + 1)[1] = "-")
+                          then error_handler ("option -" + arg[2+j] + " requires an argument")
+                          fi;
+                          (handler of opt) (argv (i + 1));
+                          skip_next_opt := true
+                     else continue := (handler of opt) ("")
+                     fi
+                  od
+             fi
+          od
+    end;
+
+    proc char_in_string = (string s, char c) int:
+    begin int res := 0, bool found := false;
+          for i to UPB s while NOT found
+          do (s[i] = c | res := i; found := true) od;
+          res
+    end;
+
+    skip
+fed

gcc/testsuite/algol68/compile/module-2.a68

@@ -0,0 +1,16 @@
+module Foo = def pub int idpublic = 10;
+                 int idprivate = 20;
+                 pub int varpublic := 100;
+                 real varprivate := 3.14;
+                 pub proc lala = (int a, b) int: a + b;
+                 pub proc lele := (int a, b) int: a - b;
+                 skip
+             fed,
+       Bar = def pub int idpublic = 30;
+                 int idprivate = 40;
+                 pub int varpublic := 100;
+                 real varprivate := 3.14;
+                 pub proc lala = (int a, b) int: a + b;
+                 pub proc lele := (int a, b) int: a - b;
+                 skip
+             fed

gcc/testsuite/algol68/compile/module-extracts-1.a68

@@ -0,0 +1,29 @@
+{ dg-options "-O0 -dA" }
+
+module Foo =
+def pub mode JURL = union (void,int,real);
+    { dg-final { scan-assembler "mode extract FOO_JURL" } }
+    pub proc plus = (int a, b) int: a + b;
+    { dg-final { scan-assembler "identifier extract FOO_plus" } }
+    pub proc vplus := (int a, b) int: a + b;
+    { dg-final { scan-assembler "identifier extract FOO_vplus" } }
+    pub proc lvplus := (int a, b) int: a + b;
+    { dg-final { scan-assembler "identifier extract FOO_lvplus" } }
+    pub heap proc hvplus := (int a, b) int: a + b;
+    { dg-final { scan-assembler "identifier extract FOO_hvplus" } }
+    pub proc(int,int)int vplus2 = vplus;
+    { dg-final { scan-assembler "identifier extract FOO_vplus2" } }
+    pub proc(int,int)int lvplus2 := lvplus;
+    { dg-final { scan-assembler "identifier extract FOO_lvplus2" } }
+    pub heap proc(int,int)int hvplus2 := hvplus;
+    { dg-final { scan-assembler "identifier extract FOO_hvplus2" } }
+    pub int i;
+    { dg-final { scan-assembler "identifier extract FOO_i" } }
+    int k = 10;
+    { dg-final { scan-assembler-not "identifier extract FOO_k" } }
+    pub prio // = 8;
+    { dg-final { scan-assembler "operator extract FOO_s_s_\[0-9\]+" } }
+    pub op // = (int a, b) int: a % b;
+    { dg-final { scan-assembler "operator extract FOO_s_s_\[0-9\]+" } }
+    skip
+fed

gcc/testsuite/algol68/compile/module-mode-exports-1.a68

@@ -0,0 +1,21 @@
+{ dg-options "-dA" }
+
+{ Test for mode table in module definition exports. }
+
+module Foo =
+def pub mode MyInt = int;
+    pub mode MyLongInt = long int;
+    pub mode MyLongLongInt = long long int;
+    pub mode MyShortInt = short int;
+    pub mode MyShortShortInt = short short int;
+    skip
+fed
+
+{ GA68_MODE_INT = 2UB }
+
+{ dg-final { scan-assembler-times "2\[\t ]+\[^0-9\]+int" 5 } }
+{ dg-final { scan-assembler-times "\[\t \]+0x2\[\t \]+\[^\n\]*sizety" 1 } }
+{ dg-final { scan-assembler-times "\[\t \]+0x1\[\t \]+\[^\n\]*sizety" 1 } }
+{ dg-final { scan-assembler-times "\[\t \]+0\[\t \]+\[^\n\]*sizety" 1 } }
+{ dg-final { scan-assembler-times "\[\t \]+0xff\[\t \]+\[^\n\]*sizety" 1 } }
+{ dg-final { scan-assembler-times "\[\t \]+0xfe\[\t \]+\[^\n\]*sizety" 1 } }

gcc/testsuite/algol68/compile/module-mode-exports-2.a68

@@ -0,0 +1,17 @@
+{ dg-options "-dA" }
+
+{ Test for mode table in module definition exports. }
+
+module Foo =
+def pub mode MyReal = real;
+    pub mode MyLongReal = long real;
+    pub mode MyLongLongReal = long long real;
+    skip
+fed
+
+{ GA68_MODE_REAL = 3UB }
+
+{ dg-final { scan-assembler-times "\[\t \]+0x3\[\t \]+\[^\n\]*real" 3 } }
+{ dg-final { scan-assembler-times "\[\t \]+0x2\[\t \]+\[^\n\]*sizety" 1 } }
+{ dg-final { scan-assembler-times "\[\t \]+0x1\[\t \]+\[^\n\]*sizety" 1 } }
+{ dg-final { scan-assembler-times "\[\t \]+0\[\t \]+\[^\n\]*sizety" 1 } }

gcc/testsuite/algol68/compile/module-mode-exports-3.a68

@@ -0,0 +1,12 @@
+{ dg-options "-dA" }
+
+{ Test for mode table in module definition exports. }
+
+module Foo =
+def pub mode MyString = string;
+    skip
+fed
+
+{ GA68_MODE_STRING = 14UB }
+
+{ dg-final { scan-assembler-times "\[\t \]+0xe\[\t \]+\[^\n\]*string" 1 } }