From: Jose E. Marchesi Date: Sat, 11 Oct 2025 17:57:40 +0000 (+0200) Subject: a68: testsuite: compilation tests X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=623d5a03bd40c61296aee19874554fa8774cb821;p=thirdparty%2Fgcc.git a68: testsuite: compilation tests Signed-off-by: Jose E. Marchesi 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. --- diff --git a/gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68 b/gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68 new file mode 100644 index 00000000000..c287d6a9309 --- /dev/null +++ b/gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68 @@ -0,0 +1,4 @@ +proc goodbye = (string name) string: +begin string msg := "Goodbye " + name; + msg +end; diff --git a/gcc/testsuite/algol68/compile/a68includes/goodbye.a68 b/gcc/testsuite/algol68/compile/a68includes/goodbye.a68 new file mode 100644 index 00000000000..19c3acc5779 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/algol68/compile/a68includes/hello-supper.a68 b/gcc/testsuite/algol68/compile/a68includes/hello-supper.a68 new file mode 100644 index 00000000000..2af568bcb01 --- /dev/null +++ b/gcc/testsuite/algol68/compile/a68includes/hello-supper.a68 @@ -0,0 +1,5 @@ +proc hello = (string name) string: +begin string msg := "Hello " + name; + msg +end; + diff --git a/gcc/testsuite/algol68/compile/a68includes/hello.a68 b/gcc/testsuite/algol68/compile/a68includes/hello.a68 new file mode 100644 index 00000000000..aa72e282d2c --- /dev/null +++ b/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; diff --git a/gcc/testsuite/algol68/compile/actual-bounds-expected-1.a68 b/gcc/testsuite/algol68/compile/actual-bounds-expected-1.a68 new file mode 100644 index 00000000000..58309db74fd --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/actual-bounds-expected-2.a68 b/gcc/testsuite/algol68/compile/actual-bounds-expected-2.a68 new file mode 100644 index 00000000000..e80e8cb45c0 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/actual-bounds-expected-3.a68 b/gcc/testsuite/algol68/compile/actual-bounds-expected-3.a68 new file mode 100644 index 00000000000..26ddd279f05 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/balancing-1.a68 b/gcc/testsuite/algol68/compile/balancing-1.a68 new file mode 100644 index 00000000000..62d1221f675 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/bold-nestable-comment-1.a68 b/gcc/testsuite/algol68/compile/bold-nestable-comment-1.a68 new file mode 100644 index 00000000000..0820c3d20c2 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/bold-taggle-1.a68 b/gcc/testsuite/algol68/compile/bold-taggle-1.a68 new file mode 100644 index 00000000000..77ce9e7c2fa --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68 b/gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68 new file mode 100644 index 00000000000..045b9b56d57 --- /dev/null +++ b/gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68 @@ -0,0 +1,4 @@ +begin { This is a + { nestable } comment in brief style. } + skip +end diff --git a/gcc/testsuite/algol68/compile/brief-nestable-comment-2.a68 b/gcc/testsuite/algol68/compile/brief-nestable-comment-2.a68 new file mode 100644 index 00000000000..a4e5d3ebb87 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/char-break-1.a68 b/gcc/testsuite/algol68/compile/char-break-1.a68 new file mode 100644 index 00000000000..30308b3df4b --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/compile.exp b/gcc/testsuite/algol68/compile/compile.exp new file mode 100644 index 00000000000..68fa5fa2625 --- /dev/null +++ b/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 +# . + +# 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 diff --git a/gcc/testsuite/algol68/compile/conditional-clause-1.a68 b/gcc/testsuite/algol68/compile/conditional-clause-1.a68 new file mode 100644 index 00000000000..a727bc21e58 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-bold-taggle-1.a68 b/gcc/testsuite/algol68/compile/error-bold-taggle-1.a68 new file mode 100644 index 00000000000..d813e55e5ba --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-coercion-1.a68 b/gcc/testsuite/algol68/compile/error-coercion-1.a68 new file mode 100644 index 00000000000..d0e24821f27 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-coercion-2.a68 b/gcc/testsuite/algol68/compile/error-coercion-2.a68 new file mode 100644 index 00000000000..bb8de3064b5 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-coercion-flex-1.a68 b/gcc/testsuite/algol68/compile/error-coercion-flex-1.a68 new file mode 100644 index 00000000000..c556d703b40 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-compile-unknown-tag-1.a68 b/gcc/testsuite/algol68/compile/error-compile-unknown-tag-1.a68 new file mode 100644 index 00000000000..cd69d1a21b4 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-conformance-clause-1.a68 b/gcc/testsuite/algol68/compile/error-conformance-clause-1.a68 new file mode 100644 index 00000000000..e6cb738a2c9 --- /dev/null +++ b/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 + diff --git a/gcc/testsuite/algol68/compile/error-contraction-1.a68 b/gcc/testsuite/algol68/compile/error-contraction-1.a68 new file mode 100644 index 00000000000..f2bce73ff17 --- /dev/null +++ b/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" } # diff --git a/gcc/testsuite/algol68/compile/error-contraction-2.a68 b/gcc/testsuite/algol68/compile/error-contraction-2.a68 new file mode 100644 index 00000000000..2115a4cbfab --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-def-1.a68 b/gcc/testsuite/algol68/compile/error-def-1.a68 new file mode 100644 index 00000000000..6d7cdc87deb --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-def-1.a68 @@ -0,0 +1,3 @@ +module Foo = +def skip; { dg-error "fed" } + skip diff --git a/gcc/testsuite/algol68/compile/error-incestuous-union-1.a68 b/gcc/testsuite/algol68/compile/error-incestuous-union-1.a68 new file mode 100644 index 00000000000..519cb8a9af1 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-label-after-decl-1.a68 b/gcc/testsuite/algol68/compile/error-label-after-decl-1.a68 new file mode 100644 index 00000000000..670f8908af1 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-1.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-1.a68 new file mode 100644 index 00000000000..7a619d8408f --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-10.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-10.a68 new file mode 100644 index 00000000000..fd70de7df0d --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-11.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-11.a68 new file mode 100644 index 00000000000..156d8d39aa6 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-12.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-12.a68 new file mode 100644 index 00000000000..0dda5beb414 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-13.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-13.a68 new file mode 100644 index 00000000000..84cf830e7ec --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-14.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-14.a68 new file mode 100644 index 00000000000..24bda0a6db9 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-15.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-15.a68 new file mode 100644 index 00000000000..0136fdb4f7b --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-16.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-16.a68 new file mode 100644 index 00000000000..82359e52d95 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-17.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-17.a68 new file mode 100644 index 00000000000..e733c51c75f --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-2.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-2.a68 new file mode 100644 index 00000000000..f72b6dd1368 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-3.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-3.a68 new file mode 100644 index 00000000000..eb672c49533 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-4.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-4.a68 new file mode 100644 index 00000000000..42c6ee29b6d --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-5.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-5.a68 new file mode 100644 index 00000000000..0206d19f72f --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-6.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-6.a68 new file mode 100644 index 00000000000..5f8404363dd --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-8.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-8.a68 new file mode 100644 index 00000000000..49308860381 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-9.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-9.a68 new file mode 100644 index 00000000000..dc20eb34a34 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-module-coercions-1.a68 b/gcc/testsuite/algol68/compile/error-module-coercions-1.a68 new file mode 100644 index 00000000000..460c381299e --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-module-not-found-1.a68 b/gcc/testsuite/algol68/compile/error-module-not-found-1.a68 new file mode 100644 index 00000000000..e990c6e22fd --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-module-not-found-1.a68 @@ -0,0 +1,4 @@ +access + Foo { dg-error "cannot find module" } +begin skip end + diff --git a/gcc/testsuite/algol68/compile/error-module-ranges-1.a68 b/gcc/testsuite/algol68/compile/error-module-ranges-1.a68 new file mode 100644 index 00000000000..b377ffba736 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-nestable-comments-1.a68 b/gcc/testsuite/algol68/compile/error-nestable-comments-1.a68 new file mode 100644 index 00000000000..df00a1a9970 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-nested-comment-1.a68 b/gcc/testsuite/algol68/compile/error-nested-comment-1.a68 new file mode 100644 index 00000000000..3c78f34a51a --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-no-bounds-allowed-1.a68 b/gcc/testsuite/algol68/compile/error-no-bounds-allowed-1.a68 new file mode 100644 index 00000000000..75d66bc1715 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-pragmat-1.a68 b/gcc/testsuite/algol68/compile/error-pragmat-1.a68 new file mode 100644 index 00000000000..8c5f1c1d899 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68 b/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68 new file mode 100644 index 00000000000..2eb4ceb7ef5 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68 b/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68 new file mode 100644 index 00000000000..643fcce0773 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-pub-loc-1.a68 b/gcc/testsuite/algol68/compile/error-pub-loc-1.a68 new file mode 100644 index 00000000000..eb174806c44 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-pub-out-of-def-1.a68 b/gcc/testsuite/algol68/compile/error-pub-out-of-def-1.a68 new file mode 100644 index 00000000000..372bfbbcfd8 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-pub-out-of-def-2.a68 b/gcc/testsuite/algol68/compile/error-pub-out-of-def-2.a68 new file mode 100644 index 00000000000..d911e3d6d7c --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-string-break-1.a68 b/gcc/testsuite/algol68/compile/error-string-break-1.a68 new file mode 100644 index 00000000000..fd8e765ab48 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-string-break-2.a68 b/gcc/testsuite/algol68/compile/error-string-break-2.a68 new file mode 100644 index 00000000000..465f8f80404 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-2.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(U0000) world") # { dg-error "eight" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-3.a68 b/gcc/testsuite/algol68/compile/error-string-break-3.a68 new file mode 100644 index 00000000000..e4cf8f6f1a3 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-3.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(u00) world") # { dg-error "four" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-4.a68 b/gcc/testsuite/algol68/compile/error-string-break-4.a68 new file mode 100644 index 00000000000..76adff9b2bc --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-4.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(u) world") # { dg-error "four" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-5.a68 b/gcc/testsuite/algol68/compile/error-string-break-5.a68 new file mode 100644 index 00000000000..c42589fde7c --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-5.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(u0010u0020) world") # { dg-error "" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-6.a68 b/gcc/testsuite/algol68/compile/error-string-break-6.a68 new file mode 100644 index 00000000000..fed7d84b221 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-6.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(u0010'/) world") # { dg-error "" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-7.a68 b/gcc/testsuite/algol68/compile/error-string-break-7.a68 new file mode 100644 index 00000000000..58545e01ce1 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-7.a68 @@ -0,0 +1,2 @@ +begin puts ("'") # { dg-error "" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-8.a68 b/gcc/testsuite/algol68/compile/error-string-break-8.a68 new file mode 100644 index 00000000000..dbc96e4e57f --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-8.a68 @@ -0,0 +1,4 @@ +begin string s = + "'(Uf09f94a5)"; { dg-error "Unicode" } + skip +end diff --git a/gcc/testsuite/algol68/compile/error-stropping-5.a68 b/gcc/testsuite/algol68/compile/error-stropping-5.a68 new file mode 100644 index 00000000000..3190472129a --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-5.a68 @@ -0,0 +1,3 @@ +begin int j; + j := "joo" { dg-error "char.*int" } +end diff --git a/gcc/testsuite/algol68/compile/error-stropping-6.a68 b/gcc/testsuite/algol68/compile/error-stropping-6.a68 new file mode 100644 index 00000000000..af6097df7c0 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-stropping-keyword-1.a68 b/gcc/testsuite/algol68/compile/error-stropping-keyword-1.a68 new file mode 100644 index 00000000000..4bf549f91e3 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-keyword-1.a68 @@ -0,0 +1,2 @@ +begin for i to 10 skip od { dg-error "do" } +end diff --git a/gcc/testsuite/algol68/compile/error-stropping-keyword-2.a68 b/gcc/testsuite/algol68/compile/error-stropping-keyword-2.a68 new file mode 100644 index 00000000000..a1e616deaeb --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-stropping-keyword-3.a68 b/gcc/testsuite/algol68/compile/error-stropping-keyword-3.a68 new file mode 100644 index 00000000000..d1076e935bd --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-keyword-3.a68 @@ -0,0 +1,2 @@ +begin if then 10 else 20 fi { dg-error "if" } +end diff --git a/gcc/testsuite/algol68/compile/error-stropping-keyword-4.a68 b/gcc/testsuite/algol68/compile/error-stropping-keyword-4.a68 new file mode 100644 index 00000000000..92b0b3b58cb --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-supper-1.a68 b/gcc/testsuite/algol68/compile/error-supper-1.a68 new file mode 100644 index 00000000000..f2646c41b7b --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-supper-1.a68 @@ -0,0 +1,3 @@ +# { dg-options {-fstropping=upper} } # + +begin ~ end # { dg-error "" } # diff --git a/gcc/testsuite/algol68/compile/error-supper-2.a68 b/gcc/testsuite/algol68/compile/error-supper-2.a68 new file mode 100644 index 00000000000..f8c6c284b20 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-supper-3.a68 b/gcc/testsuite/algol68/compile/error-supper-3.a68 new file mode 100644 index 00000000000..a35730ce1f7 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-supper-4.a68 b/gcc/testsuite/algol68/compile/error-supper-4.a68 new file mode 100644 index 00000000000..726f80638d6 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-supper-5.a68 b/gcc/testsuite/algol68/compile/error-supper-5.a68 new file mode 100644 index 00000000000..0cf51c519de --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-supper-6.a68 b/gcc/testsuite/algol68/compile/error-supper-6.a68 new file mode 100644 index 00000000000..c013b4894b3 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-underscore-in-mode-1.a68 b/gcc/testsuite/algol68/compile/error-underscore-in-mode-1.a68 new file mode 100644 index 00000000000..2aa294d1f02 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-underscore-in-tag-1.a68 b/gcc/testsuite/algol68/compile/error-underscore-in-tag-1.a68 new file mode 100644 index 00000000000..a5dcb86b6e1 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-upper-1.a68 b/gcc/testsuite/algol68/compile/error-upper-1.a68 new file mode 100644 index 00000000000..053846972ac --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-upper-1.a68 @@ -0,0 +1,3 @@ +# { dg-options {-fstropping=supper} } # + +BEGIN ~ END # { dg-error "" } # diff --git a/gcc/testsuite/algol68/compile/error-vacuum-1.a68 b/gcc/testsuite/algol68/compile/error-vacuum-1.a68 new file mode 100644 index 00000000000..0e724592e25 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-vacuum-1.a68 @@ -0,0 +1,2 @@ +begin { dg-error "" } +end diff --git a/gcc/testsuite/algol68/compile/error-vacuum-2.a68 b/gcc/testsuite/algol68/compile/error-vacuum-2.a68 new file mode 100644 index 00000000000..fe9716aeef4 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-vacuum-2.a68 @@ -0,0 +1,2 @@ +( { dg-error "" } +) diff --git a/gcc/testsuite/algol68/compile/error-vacuum-3.a68 b/gcc/testsuite/algol68/compile/error-vacuum-3.a68 new file mode 100644 index 00000000000..fc096002709 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-vacuum-3.a68 @@ -0,0 +1,3 @@ +begin struct(int i, real r) foo = (); { dg-error "" } + skip +end diff --git a/gcc/testsuite/algol68/compile/error-widening-1.a68 b/gcc/testsuite/algol68/compile/error-widening-1.a68 new file mode 100644 index 00000000000..38ea59afb28 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-widening-2.a68 b/gcc/testsuite/algol68/compile/error-widening-2.a68 new file mode 100644 index 00000000000..3165d1b7113 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-widening-3.a68 b/gcc/testsuite/algol68/compile/error-widening-3.a68 new file mode 100644 index 00000000000..c4ffb305a62 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-widening-4.a68 b/gcc/testsuite/algol68/compile/error-widening-4.a68 new file mode 100644 index 00000000000..fa5b2072e17 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-widening-5.a68 b/gcc/testsuite/algol68/compile/error-widening-5.a68 new file mode 100644 index 00000000000..a6198669c45 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-widening-6.a68 b/gcc/testsuite/algol68/compile/error-widening-6.a68 new file mode 100644 index 00000000000..09512e21678 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-widening-7.a68 b/gcc/testsuite/algol68/compile/error-widening-7.a68 new file mode 100644 index 00000000000..09352081583 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-widening-8.a68 b/gcc/testsuite/algol68/compile/error-widening-8.a68 new file mode 100644 index 00000000000..098f6c3b615 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/error-widening-9.a68 b/gcc/testsuite/algol68/compile/error-widening-9.a68 new file mode 100644 index 00000000000..4d092386b61 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/hidden-operators-1.a68 b/gcc/testsuite/algol68/compile/hidden-operators-1.a68 new file mode 100644 index 00000000000..d66242d67a6 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/implicit-widening-1.a68 b/gcc/testsuite/algol68/compile/implicit-widening-1.a68 new file mode 100644 index 00000000000..2fa010c12a7 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/include-supper.a68 b/gcc/testsuite/algol68/compile/include-supper.a68 new file mode 100644 index 00000000000..af0521be101 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/include.a68 b/gcc/testsuite/algol68/compile/include.a68 new file mode 100644 index 00000000000..6f4855b33da --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/labeled-unit-1.a68 b/gcc/testsuite/algol68/compile/labeled-unit-1.a68 new file mode 100644 index 00000000000..d3dbd8c40d7 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/module-1.a68 b/gcc/testsuite/algol68/compile/module-1.a68 new file mode 100644 index 00000000000..e4f3215cc35 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/module-2.a68 b/gcc/testsuite/algol68/compile/module-2.a68 new file mode 100644 index 00000000000..74bd2369022 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/module-extracts-1.a68 b/gcc/testsuite/algol68/compile/module-extracts-1.a68 new file mode 100644 index 00000000000..c56a1d877c1 --- /dev/null +++ b/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 diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-1.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-1.a68 new file mode 100644 index 00000000000..8a4f50ef50c --- /dev/null +++ b/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 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-2.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-2.a68 new file mode 100644 index 00000000000..fb67b3db6a3 --- /dev/null +++ b/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 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-3.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-3.a68 new file mode 100644 index 00000000000..b0309032a4f --- /dev/null +++ b/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 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-4.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-4.a68 new file mode 100644 index 00000000000..9846f19e7df --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-4.a68 @@ -0,0 +1,12 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyChar = char; + skip +fed + +{ GA68_MODE_CHAR = 6UB } + +{ dg-final { scan-assembler-times "\[\t \]+0x6\[\t \]+\[^\n\]*char" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-5.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-5.a68 new file mode 100644 index 00000000000..be4deef2c69 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-5.a68 @@ -0,0 +1,21 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyBits = bits; + pub mode MyLongBits = long bits; + pub mode MyLongLongBits = long long bits; + pub mode MyShortBits = short bits; + pub mode MyShortShortBits = short short bits; + skip +fed + +{ GA68_MODE_BITS = 4UB } + +{ dg-final { scan-assembler-times "4\[\t ]+\[^0-9\]+bits" 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 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-6.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-6.a68 new file mode 100644 index 00000000000..18a7d4fd3ed --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-6.a68 @@ -0,0 +1,15 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyBool = bool; + pub mode MyVoid = void; + skip +fed + +{ GA68_MODE_BOOL = 7UB + GA68_MODE_VOID = 1UB } + +{ dg-final { scan-assembler-times "7\[\t ]+\[^0-9\]+bool" 1 } } +{ dg-final { scan-assembler-times "1\[\t ]+\[^0-9\]+void" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-7.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-7.a68 new file mode 100644 index 00000000000..b76085b7681 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-7.a68 @@ -0,0 +1,13 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyName = ref int; + skip +fed + +{ GA68_MODE_NAME = 12UB } + +{ dg-final { scan-assembler-times "0xc\[\t ]+\[^0-9\]+ref" 1 } } +{ dg-final { scan-assembler-times "0x2\[\t ]+\[^0-9\]+int" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-8.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-8.a68 new file mode 100644 index 00000000000..c38502a25bb --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-8.a68 @@ -0,0 +1,17 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyCompl = compl; + pub mode MyLongCompl = long compl; + pub mode MyLongLongCompl = long long compl; + skip +fed + +{ GA68_MODE_CMPL = 8UB } + +{ dg-final { scan-assembler-times "0x8\[\t ]+\[^0-9\]+compl" 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 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-9.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-9.a68 new file mode 100644 index 00000000000..482aab6ea32 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-9.a68 @@ -0,0 +1,12 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyProc = proc void; + skip +fed + +{ GA68_MODE_CMPL = 8UB } + +{ dg-final { scan-assembler-times "0xd\[\t ]+\[^0-9\]+proc" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-pub-1.a68 b/gcc/testsuite/algol68/compile/module-pub-1.a68 new file mode 100644 index 00000000000..a0cf6e9e328 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-1.a68 @@ -0,0 +1,16 @@ +module Foo = +def pub mode JORL = int, JURL = union (void,int,real); + pub proc plus = (int a, b) int: a + b; + pub proc vplus := (int a, b) int: a + b; + pub proc lvplus := (int a, b) int: a + b; + pub heap proc hvplus := (int a, b) int: a + b; + pub proc(int,int)int vplus2 = vplus; + pub proc(int,int)int lvplus2 := lvplus; + pub heap proc(int,int)int hvplus2 := hvplus; + pub int i, x, y; + pub int k = 10; + pub int j := 20; + pub prio // = 8; + pub op // = (int a, b) int: a % b; + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-1.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-1.a68 new file mode 100644 index 00000000000..3451f46a8ff --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-1.a68 @@ -0,0 +1,15 @@ +{ dg-options "-O0" } + +module Foo = def pub int foo; { dg-final { scan-assembler "FOO_foo" } } + int bar; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub int foo; { dg-final { scan-assembler "BAR_foo" } } + int bar; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-10.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-10.a68 new file mode 100644 index 00000000000..e427181bf53 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-10.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio + = 9; + op + = (int a, b) int: skip; { dg-final { scan-assembler "FOO_u_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-11.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-11.a68 new file mode 100644 index 00000000000..3ba8b68ade2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-11.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio - = 9; + op - = (int a, b) int: skip; { dg-final { scan-assembler "FOO_m_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-12.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-12.a68 new file mode 100644 index 00000000000..9efc781f644 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-12.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio % = 9; + op % = (int a, b) int: skip; { dg-final { scan-assembler "FOO_p_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-13.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-13.a68 new file mode 100644 index 00000000000..48347477622 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-13.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio ^ = 9; + op ^ = (int a, b) int: skip; { dg-final { scan-assembler "FOO_c_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-14.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-14.a68 new file mode 100644 index 00000000000..60ffc3d90dc --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-14.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio & = 9; + op & = (int a, b) int: skip; { dg-final { scan-assembler "FOO_a_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-15.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-15.a68 new file mode 100644 index 00000000000..9f70993099d --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-15.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio ~ = 9; + op ~ = (int a, b) int: skip; { dg-final { scan-assembler "FOO_t_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-16.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-16.a68 new file mode 100644 index 00000000000..a5a7d261e2b --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-16.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio ! = 9; + op ! = (int a, b) int: skip; { dg-final { scan-assembler "FOO_b_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-17.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-17.a68 new file mode 100644 index 00000000000..1f5b52a9d4a --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-17.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio ? = 9; + op ? = (int a, b) int: skip; { dg-final { scan-assembler "FOO_q_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-18.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-18.a68 new file mode 100644 index 00000000000..a840b14bf50 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-18.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio > = 9; + op > = (int a, b) int: skip; { dg-final { scan-assembler "FOO_g_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-19.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-19.a68 new file mode 100644 index 00000000000..ffcd1cfc79b --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-19.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio < = 9; + op < = (int a, b) int: skip; { dg-final { scan-assembler "FOO_l_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-2.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-2.a68 new file mode 100644 index 00000000000..79fe3d84cd7 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-2.a68 @@ -0,0 +1,15 @@ +{ dg-options "-O0" } + +module Foo = def pub struct (int i, real r) foo;{ dg-final { scan-assembler "FOO_foo" } } + struct (int i, real r) bar; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub struct (int i, real r) foo;{ dg-final { scan-assembler "BAR_foo" } } + struct (int i, real r) bar; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-20.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-20.a68 new file mode 100644 index 00000000000..fd435c7e50a --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-20.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio / = 9; + op / = (int a, b) int: skip; { dg-final { scan-assembler "FOO_s_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-21.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-21.a68 new file mode 100644 index 00000000000..05b2b0a6647 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-21.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio = = 9; + op = = (int a, b) int: skip; { dg-final { scan-assembler "FOO_e_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-22.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-22.a68 new file mode 100644 index 00000000000..d11e9a8e4c8 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-22.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio +:= = 9; + op +:= = (int a, b) int: skip; { dg-final { scan-assembler "FOO_u_o_e_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-3.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-3.a68 new file mode 100644 index 00000000000..579cb84eac0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-3.a68 @@ -0,0 +1,15 @@ +{ dg-options "-O0" } + +module Foo = def pub int foo = 10; { dg-final { scan-assembler "FOO_foo" } } + int bar = 20; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub int foo = 30; { dg-final { scan-assembler "BAR_foo" } } + int bar = 40; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-4.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-4.a68 new file mode 100644 index 00000000000..4bb53949ba3 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-4.a68 @@ -0,0 +1,17 @@ +{ dg-options "-O0" } + +{ Procedure variable declarations. } + +module Foo = def pub proc int foo; { dg-final { scan-assembler "FOO_foo" } } + proc int bar := int: skip; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub proc int foo; { dg-final { scan-assembler "BAR_foo" } } + proc int bar := foo; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-5.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-5.a68 new file mode 100644 index 00000000000..be29ee19095 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-5.a68 @@ -0,0 +1,17 @@ +{ dg-options "-O0" } + +{ Procedure identity declarations. } + +module Foo = def pub proc foo = int: skip; { dg-final { scan-assembler "FOO_foo" } } + proc bar = int: skip; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub proc foo = int: skip; { dg-final { scan-assembler "BAR_foo" } } + proc bar = int: skip; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-6.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-6.a68 new file mode 100644 index 00000000000..8ba5333ea84 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-6.a68 @@ -0,0 +1,21 @@ +{ dg-options "-O0" } + +{ Operator brief identity declarations. } + +module Foo = def pub op + = (int a, b) int: a + b; + { dg-final { scan-assembler "FOO_u_" } } + op - = (int a, b) int: a - b; + { dg-final { scan-assembler "FOO_m_" } } + skip + fed, + Bar = def pub op + = (int a, b) int: a + b; + { dg-final { scan-assembler "BAR_u_" } } + op - = (int a, b) int: a - b; + { dg-final { scan-assembler "BAR_m_" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-7.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-7.a68 new file mode 100644 index 00000000000..5c62a798787 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-7.a68 @@ -0,0 +1,19 @@ +{ dg-options "-O0" } + +{ Operator identity declarations. } + +module Foo = +def prio // = 8; + pub op(int,int)int // = lala; + { dg-final { scan-assembler "FOO_s_s_" } } + proc lala = (int a, b) int: a + b; + prio JORL = 8, JURL = 9; + pub op(int,int)int JORL = lala; + { dg-final { scan-assembler "FOO_JORL" } } + op(int,int)int JURL = (int a, b) int: a - b; + { dg-final { scan-assembler "FOO_JORL" } } + skip +fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-8.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-8.a68 new file mode 100644 index 00000000000..054befb7c6f --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-8.a68 @@ -0,0 +1,18 @@ +{ dg-options "-O0" } + +{ Symbols that should _not_ include the module name. } + +module Foo = +def begin string foo = "foo'n"; { dg-final { scan-assembler-not "FOO_foo" } } + proc printfoo = void: puts (foo); { dg-final { scan-assembler-not "FOO_printfoo" } } + printfoo + end; + skip +postlude + int lala; + proc incrlala = void: lala +:= 1; { dg-final { scan-assembler-not "FOO_incrlala" } } + incrlala +fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-9.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-9.a68 new file mode 100644 index 00000000000..6a6bab1211f --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-9.a68 @@ -0,0 +1,14 @@ +{ dg-options "-O0" } + +{ Operator symbols are numbered so having overloaded symbols in the + module's public range works. } + +module Foo = +def prio // =9; + op // = (int a, b) int: a + b; { dg-final { scan-assembler "FOO_s_s_\[0-9\]+" } } + op // = (real a, b) real: a + b; { dg-final { scan-assembler "FOO_s_s_\[0-9\]+" } } + skip +fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-top-down-1.a68 b/gcc/testsuite/algol68/compile/module-top-down-1.a68 new file mode 100644 index 00000000000..3f130c25019 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-top-down-1.a68 @@ -0,0 +1,14 @@ +{ This test is to check that serial clauses and + enquiry clauses are properly skipped in module texts. } +module Foo = +def int i; + int j = 20; + string ss; + prio // = 8; + op // = (int a, b) int: a + b; + proc ticks = void: to i do puts ("tick'n") od; + i := 5 +postlude + if j > 5 then ticks fi; + (j < 0 | puts ("error'n") | puts ("success'n")) +fed diff --git a/gcc/testsuite/algol68/compile/modules/compile.exp b/gcc/testsuite/algol68/compile/modules/compile.exp new file mode 100644 index 00000000000..af254e8e594 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/compile.exp @@ -0,0 +1,40 @@ +# 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 +# . + +# 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 + +# The programs need to be able to find the built modules, which are +# left in objdir. + +global MODULES_OPTIONS +set MODULES_OPTIONS "-I $objdir" + +# 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/program*.a68]] "" "" +set dg-do-what-default ${saved-dg-do-what-default} + +# All done. +dg-finish diff --git a/gcc/testsuite/algol68/compile/modules/module1.a68 b/gcc/testsuite/algol68/compile/modules/module1.a68 new file mode 100644 index 00000000000..f49a747033e --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module1.a68 @@ -0,0 +1,9 @@ +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 diff --git a/gcc/testsuite/algol68/compile/modules/module2.a68 b/gcc/testsuite/algol68/compile/modules/module2.a68 new file mode 100644 index 00000000000..57c68e579b8 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module2.a68 @@ -0,0 +1,5 @@ +module Module2 = +def prio // = 9; { Note priority is not publicized. } + pub op // = (int a, b) int: a + b; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module3.a68 b/gcc/testsuite/algol68/compile/modules/module3.a68 new file mode 100644 index 00000000000..143a4693593 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module3.a68 @@ -0,0 +1,6 @@ +module Module_3 = +def pub proc foo = (int i, string s) void: skip; + pub mode Jorl = struct (int i, string s); + pub mode Jurl = union (int, string, real); + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module4.a68 b/gcc/testsuite/algol68/compile/modules/module4.a68 new file mode 100644 index 00000000000..f0ae6e689b4 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module4.a68 @@ -0,0 +1,4 @@ +module Module_4 = +def access Module_3 (foo (10, "foo")); + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module5.a68 b/gcc/testsuite/algol68/compile/modules/module5.a68 new file mode 100644 index 00000000000..ebb06fb329a --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module5.a68 @@ -0,0 +1,6 @@ +module Module_5 = +def + pub mode JSON_Val = union (ref JSON_Elm,int), + JSON_Elm = struct (int lala); + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module6.a68 b/gcc/testsuite/algol68/compile/modules/module6.a68 new file mode 100644 index 00000000000..b0fefb5522f --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module6.a68 @@ -0,0 +1,5 @@ +module Module6 = + access Module5 +def pub proc getval = JSON_VAl: skip; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module7.a68 b/gcc/testsuite/algol68/compile/modules/module7.a68 new file mode 100644 index 00000000000..f585171bf27 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module7.a68 @@ -0,0 +1,5 @@ +module Module7 = +access Module5, Module6 +def pub JSON_Val val = getval; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module8.a68 b/gcc/testsuite/algol68/compile/modules/module8.a68 new file mode 100644 index 00000000000..8704474436c --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module8.a68 @@ -0,0 +1,5 @@ +module Module_8 = +def + pub proc lala = ([]struct (string n, v) arg) void: skip; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module9.a68 b/gcc/testsuite/algol68/compile/modules/module9.a68 new file mode 100644 index 00000000000..55afd6fef75 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module9.a68 @@ -0,0 +1,6 @@ +module Module_9 = +def + pub mode Foo = struct (flex[1:0]Event events); + pub mode Event = int; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/program-7.a68 b/gcc/testsuite/algol68/compile/modules/program-7.a68 new file mode 100644 index 00000000000..a3cb1bf2a72 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-7.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module5 module6 module7" } + +access Module7 (skip) diff --git a/gcc/testsuite/algol68/compile/modules/program-8.a68 b/gcc/testsuite/algol68/compile/modules/program-8.a68 new file mode 100644 index 00000000000..ba767550398 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-8.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module8" } + +access Module_8 ( lala ((("foo", "bar"), ("baz", "quux"))) ) diff --git a/gcc/testsuite/algol68/compile/modules/program-9.a68 b/gcc/testsuite/algol68/compile/modules/program-9.a68 new file mode 100644 index 00000000000..585607ae36b --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-9.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module9" } + +access Module_9 (skip) diff --git a/gcc/testsuite/algol68/compile/modules/program-error-no-prio-1.a68 b/gcc/testsuite/algol68/compile/modules/program-error-no-prio-1.a68 new file mode 100644 index 00000000000..dcca8a9baeb --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-error-no-prio-1.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module2" } + +access Module_2 +begin assert (2 // 3 = 5); { dg-error "no priority" } + skip +end diff --git a/gcc/testsuite/algol68/compile/modules/program-error-outside-access-1.a68 b/gcc/testsuite/algol68/compile/modules/program-error-outside-access-1.a68 new file mode 100644 index 00000000000..39f0f1896f8 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-error-outside-access-1.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module1" } + +begin int x = access Module1 ( beast_number ), + y = beast_number; { dg-error "declared" } + skip +end diff --git a/gcc/testsuite/algol68/compile/modules/program-module-accesses-module-1.a68 b/gcc/testsuite/algol68/compile/modules/program-module-accesses-module-1.a68 new file mode 100644 index 00000000000..7ba7804636c --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-module-accesses-module-1.a68 @@ -0,0 +1,5 @@ +{ dg-modules "module3 module4" } +{ This test accesses a Module4 that itself accesses a Module3. } + +access Module_4 (skip) + diff --git a/gcc/testsuite/algol68/compile/modules/program-proc-arg-order-1.a68 b/gcc/testsuite/algol68/compile/modules/program-proc-arg-order-1.a68 new file mode 100644 index 00000000000..eecf6867ba1 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-proc-arg-order-1.a68 @@ -0,0 +1,8 @@ +{ dg-modules "module3" } + +access Module_3 +begin foo (10, "foo"); + Jorl x = (10, "foo"); + Jurl y = 3.14; + skip +end diff --git a/gcc/testsuite/algol68/compile/nested-comment-1.a68 b/gcc/testsuite/algol68/compile/nested-comment-1.a68 new file mode 100644 index 00000000000..f5752435a0e --- /dev/null +++ b/gcc/testsuite/algol68/compile/nested-comment-1.a68 @@ -0,0 +1,4 @@ +{ Comment delimiters within strings get ignored. } +begin { puts { ("{""'n"); } } + skip +end diff --git a/gcc/testsuite/algol68/compile/nested-comment-2.a68 b/gcc/testsuite/algol68/compile/nested-comment-2.a68 new file mode 100644 index 00000000000..9fc912f2687 --- /dev/null +++ b/gcc/testsuite/algol68/compile/nested-comment-2.a68 @@ -0,0 +1,6 @@ +{ The string in nested comment is in one logical line. } +begin + { puts ("{'n\ +"); { this prints foo }} + skip +end diff --git a/gcc/testsuite/algol68/compile/operators-firmly-related.a68 b/gcc/testsuite/algol68/compile/operators-firmly-related.a68 new file mode 100644 index 00000000000..a7efe750219 --- /dev/null +++ b/gcc/testsuite/algol68/compile/operators-firmly-related.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN PRIO MIN = 6; + OP MIN = (REF REAL a, b) REF REAL: (a < b | a | b), # { dg-error "firmly related" } # + MIN = (REAL a, b) REAL: (a < b | a | b); # { dg-error "firmly related" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/recursive-modes-1.a68 b/gcc/testsuite/algol68/compile/recursive-modes-1.a68 new file mode 100644 index 00000000000..4a77a5646be --- /dev/null +++ b/gcc/testsuite/algol68/compile/recursive-modes-1.a68 @@ -0,0 +1,33 @@ +# { dg-options "-fstropping=upper" } # + +# This program triggered a bug related to incomplete modes. # +BEGIN MODE REC_MSET = STRUCT (REF REC_MSET_ELM head, tail, + INT num elems, + PROC(REC_MSET_DATA)BOOL gate), + REC_MSET_ELM = STRUCT (REC_MSET_DATA data, BOOL mark, REF REC_MSET_ELM next), + REC_MSET_DATA = UNION (REC_RSET,REC_RECORD,REC_FIELD,REC_CMNT), + REC_RSET = STRUCT (REC_MSET mset, + INT min size, max size, + REF REC_RECORD descriptor), + REC_RECORD = STRUCT (REC_LOC loc, REC_MSET mset, INT foo), + REC_CMNT = STRUCT (REC_LOC loc, STRING content), + REC_FIELD = STRUCT (REC_LOC loc, STRING name, value), + REC_LOC = STRUCT (STRING source, INT line, char); + + PROC rec loc unknown = REC_LOC: + ("unknown", 0, 0); + PROC rec record gate = (REC_MSET_DATA d) BOOL: + (d | (REC_FIELD): TRUE, (REC_CMNT): TRUE | FALSE); + REF REC_MSET_ELM rec no mset elm = NIL; + + PROC rec mset new = (PROC(REC_MSET_DATA)BOOL gate) REC_MSET: + (HEAP REC_MSET := (rec no mset elm, rec no mset elm, + 0, gate)); + + REF REC_RECORD rec no record = NIL; + + PROC rec record new = REF REC_RECORD: + HEAP REC_RECORD := (rec loc unknown, rec mset new (rec record gate), 0); + + SKIP +END diff --git a/gcc/testsuite/algol68/compile/recursive-modes-2.a68 b/gcc/testsuite/algol68/compile/recursive-modes-2.a68 new file mode 100644 index 00000000000..f79b214d075 --- /dev/null +++ b/gcc/testsuite/algol68/compile/recursive-modes-2.a68 @@ -0,0 +1,7 @@ +begin mode Word = union (int, struct (ref Word w)), + Value = union (void,Word), + Stack = struct (ref Stack prev, Value val); + + struct (Word a) qs; { type_2 has no size! } + skip +end diff --git a/gcc/testsuite/algol68/compile/serial-clause-jump-1.a68 b/gcc/testsuite/algol68/compile/serial-clause-jump-1.a68 new file mode 100644 index 00000000000..f4e3773ba53 --- /dev/null +++ b/gcc/testsuite/algol68/compile/serial-clause-jump-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # + +# This is an infinite loop, but it should compile just fine an yield + an integer after infinite time. # + +BEGIN foo: foo +END diff --git a/gcc/testsuite/algol68/compile/snobol.a68 b/gcc/testsuite/algol68/compile/snobol.a68 new file mode 100644 index 00000000000..9b6c4fc824f --- /dev/null +++ b/gcc/testsuite/algol68/compile/snobol.a68 @@ -0,0 +1,1100 @@ +# { dg-options "-fstropping=upper" } # + +# This is Frank Pagan's SNOBOL4 Interpreter in ALGOL 68 (1976), + fetched from Dick Grune's page https://dickgrune.com/CS/Algol68/ + + The interpreter described in "Algol 68 as an Implementation Language\ + for Portable Interpreters", ACM SIGPLAN Notices - Proceedings of the + Strathclyde ALGOL 68 conference, Volume 12 Issue 6, June 1977, + pp. 54 - 62, and "A Highly-Structured Interpreter for a SNOBOL4 + Subset", Software: Practice and Experience, Vol. 9, 4, + pp. 281-312, April 1979. + + Modifications by Jose E. Marchesi: + - Use the simple POSIX-like transput provided by GCC. + - Read programs from lines rather than from cards. + - Add command-line option -l (listing). +# + +BEGIN PROC itoa = (INT i) STRING: + BEGIN IF i = 0 + THEN "0" + ELSE INT n := ABS i; + STRING res; + WHILE n /= 0 + DO INT rem = n %* 10; + res := REPR (rem > 9 | (rem - 10) + ABS "a" | rem + ABS "0") + res; + n %:= 10 + OD; + (i < 0 | "-" + res | res) + FI + END; + + CHAR sharp = REPR 35; # Sharp character, + to avoid confusing Emacs. # + + # Input file. # + INT filein; + + # IMPLEMENTATION RESTRICTIONS # + INT spoolsize = 400, + stlim = 50, + arglim = 5, + rslim = 80, + pslim = 20, + ftlim = 10; + + # ABSTRACT MACHINE # + MODE ITEM = UNION (INT, REF STRINGITEM, PATTERN), + STRINGITEM = STRUCT (STRING val, REF ITEM ref), + PATTERN = REF[]COMPONENT, + COMPONENT = STRUCT (INT routine, subsequent, alternate, extra, + REF ITEM arg), + PSENTRY = STRUCT (INT cursor, alternate), + RSENTRY = REF ITEM, + FTENTRY = STRUCT (REF ITEM fnname, entry name, + REF[]REF ITEM params, locals); + + [1:spoolsize] REF ITEM spool; + [1:pslim] PSENTRY pattern stack; + [1:rslim] RSENTRY run stack; + [1:ftlim] FTENTRY function table; + + BOOL failed := FALSE; + INT nin, psp, rsp := 0, ftp := 0; + INT mstr = 1, mlen = 2, mbrk = 3, mspn = 4, many = 5, mnul = 6, + miv1 = 7, miv2 = 8, m1 = 9, mat = 10, mpos = 11, mtab = 12, + mrpos = 13, mrtab = 14, mnty = 15; + + # INTERNAL FORM OF PROGRAMS # + + MODE STMT = STRUCT (REF IDR label, + UNION (REF ASMT, REF MATCH, + REF REPL, REF EXPR) stmt core, + REF GOTOFIELD goto), + IDR = STRUCT (REF ITEM idr addr), + NUM = STRUCT (REF ITEM num addr), + LSTR = STRUCT (REF ITEM lstr addr), + ASMT = STRUCT (REF EXPR subject, object), + MATCH = STRUCT (REF EXPR subject, pattern), + REPL = STRUCT (REF EXPR subject, pattern, object), + EXPR = UNION (REF UNARYEXPR, REF BINARYEXPR, IDR, NUM, + LSTR, REF CALL), + GOTOFIELD = STRUCT (REF DEST upart, spart, fpart), + DEST = UNION (REF EXPR, CHAR), + UNARYEXPR = STRUCT (REF EXPR operand, CHAR operator), + BINARYEXPR = STRUCT (REF EXPR operand1, operand2, + CHAR operator), + CALL = STRUCT (IDR fnname, REF[]REF EXPR args); + + REF[]STMT t; + REF ITEM prog entry := NIL; + + PROC error = (STRING mess) VOID: + (puts ("error: " + mess + "'n"); stop); + + # TRANSLATION PHASE # + + BEGIN # DECLARATIONS FOR SCANNER # + STRING card, INT cp, # SOURCE LINE AND POINTER # + CHAR ch, # SOURCE CHARACTER # + [1:80]CHAR str, INT sp, # STRING BUFFER AND POINTER # + CHAR tok, # TOKEN CODE # + REF ITEM psn, # POSITION OF A CREATED VALUE # + INT nv, # NUMERIC VALUE OF CONSTANT # + INT stn, # SOURCE STATEMENT NUMBER # + BOOL listing, # FLAG FOR SOURCE LISTING # + CHAR c; # TEMPORARY # + + # TOKEN MNEMONICS # + CHAR doll = "$", bdoll = "D", + plus = "+", bplus = "P", + minus = "-", bminus = "M", + at = "@", bbar = "!", + bstar = "*", bslash = "/", + lpar = "(", rpar = ")", + comma = ",", colon = ":", + equal = "=", blank = " ", + eos = ";", name = "A", + lstring = "L", number = "U", + endt = "E", ret = "R", + fret = "F", stok = "Y", + ftok = "Z"; + + PROC get card = VOID: + BEGIN cp := 0; + WHILE card := fgets (filein, 80); + IF UPB card = 0 THEN exit FI; + c := card[1]; + IF c /= "." AND c /= "+" AND c /= "-" AND c /= "*" + THEN stn := stn + 1 FI; + IF listing THEN puts (itoa (stn) + " " + card + "'n") FI; + IF c = "-" + THEN IF card[2:5] = "LIST" + THEN listing := TRUE + ELIF card[2:7] = "UNLIST" + THEN listing := FALSE + FI + FI; + c = "-" OR c = "*" + DO SKIP OD; + exit: SKIP + END; + + PROC next ch = VOID: + IF cp = UPB card + THEN get card; + IF c = "." OR c = "+" + THEN ch := " "; cp := 1 + ELSE ch := sharp # END OF LINE AND STATEMENT # + FI + ELSE ch := card[cp +:= 1] + FI; + + PROC lookup = (STRING sv) REF ITEM : ( + INT i := 0, BOOL nf := TRUE; + WHILE IF (i +:= 1) <= nin + THEN nf := sv /= val OF (spool[i] | (REF STRINGITEM s) : s) + ELSE FALSE + FI + DO SKIP OD; + IF nf + THEN IF nin = spoolsize THEN error ("too many strings") FI; + spool[nin +:= 1] := HEAP ITEM := HEAP STRINGITEM := + (sv, NIL) + FI; + spool[i]); + + PROC scan = VOID: + IF ch = " " # BLANKS AND BINARY OPERATORS # + THEN WHILE next ch; ch = " " DO SKIP OD; + # IGNORE TRAILING BLANKS IN A STATEMENT # + IF ch = ";" THEN next ch; stn := stn + 1; tok := eos + ELIF ch = sharp THEN next ch; tok := eos + ELIF ch = "!" OR ch = "$" OR ch = "+" OR ch = "-" + OR ch = "*" OR ch = "/" + THEN IF card[cp+1] = " " + THEN c := ch; + WHILE next ch; ch = " " DO SKIP OD ; + tok := (c = "!" | bbar + |: c = "$" | bdoll + |: c = "-" | bminus + |: c = "+" | bplus + |: c = "*" | bstar + | bslash) + ELSE tok := blank + FI + ELSE tok := blank + FI + ELIF ch = "''" OR ch = """" # LITERAL STRINGS # + THEN c := ch; sp := 0; + WHILE next ch; + IF ch = sharp THEN error ("UNTERMINATED LITERAL") FI; + (str[sp +:= 1] := ch) /= c + DO SKIP OD ; + next ch; + tok := lstring; + IF sp = 1 + THEN psn := NIL + ELSE STRING s = str[1:sp-1] ; + psn := lookup (s) + FI + ELIF ch >= "0" AND ch <= "9" # NUMBERS # + THEN nv := 0 ; + WHILE nv := nv * 10 + ABS ch - ABS "0"; + next ch; + ch >= "0" AND ch <= "9" + DO SKIP OD ; + tok := number; + psn := HEAP ITEM := nv + ELIF ch >= "A" AND ch <= "Z" # NAMES # + THEN sp := 0; + WHILE str[sp +:= 1] := ch; + next ch; + ch = "." OR ch >= "A" AND ch <= "Z" + OR ch >= "0" AND ch <= "9" + DO SKIP OD ; + STRING s = str[1:sp]; + tok := (s = "S" | stok + |: s = "F" | ftok + |: s = "END" | endt + |: s = "RETURN" | ret + |: s = "FRETURN" | fret + | psn := lookup (s); name) + ELIF ch = ";" + THEN next ch; stn := stn + 1; tok := eos + ELIF ch = sharp + THEN next ch; tok := eos + ELSE # ( ) , : = @ $ + - # + tok := ch; next ch + FI; + + PROC init = VOID: + BEGIN stn := 0; + spool[nin := 1] := HEAP ITEM := HEAP STRINGITEM := + ("ARB", HEAP ITEM := HEAP[1:3]COMPONENT := + ((mnul, 2, 0, SKIP, NIL), + (mnul, 0, 3, SKIP, NIL), + (m1, 2, 0, SKIP, NIL))); + get card; + next ch; + scan + END; + + PROC verify = (CHAR token) VOID: + IF tok = token THEN scan + ELSE STRING s := "TOKEN "" "" DOES NOT OCCUR WHERE EXPECTED"; + s[8] := token; + error (s) + FI; + + PROC translate = VOID: + BEGIN HEAP[1:stlim]STMT ss, INT ssc := 0; + WHILE IF ssc = stlim THEN error ("TOO MANY STATEMENTS") FI; + tok /= endt + DO ss[ssc +:= 1] := trans stmt OD; + scan; + IF tok = blank + THEN scan; + IF tok = name THEN prog entry := psn FI + FI; + t := ss[1:ssc] + END; + + PROC trans stmt = STMT: + BEGIN + REF IDR lab := NIL; + REF EXPR subj, pat, obj := NIL; + REF GOTOFIELD go := NIL; + BOOL asgn; + + PROC move to obj = STMT: + BEGIN + IF tok = blank + THEN scan; + IF tok = colon + THEN go := trans gofield + ELSE obj := trans expr; + IF tok = colon + THEN go := trans gofield + ELSE verify (eos) + FI + FI + ELSE verify (eos) + FI ; + IF asgn + THEN STMT (lab, HEAP ASMT := (subj, obj), go) + ELSE STMT (lab, HEAP REPL := (subj, pat, obj), go) + FI + END; + + PROC move to subj = STMT: + BEGIN scan; + IF tok = colon + THEN STMT (lab, REF EXPR (NIL), trans gofield) + ELSE subj := trans elem; + IF tok = blank + THEN scan; + IF tok = colon + THEN STMT (lab, REF EXPR (subj), trans gofield) + ELIF tok = equal + THEN asgn := TRUE; scan; move to obj + ELSE pat := trans expr; + IF tok = colon + THEN STMT (lab, HEAP MATCH := (subj, pat), trans gofield) + ELIF tok = equal + THEN asgn := FALSE; scan; move to obj + ELSE verify (eos); + STMT (lab, HEAP MATCH := (subj, pat), NIL) + FI + FI + ELSE verify (eos); + STMT (lab, REF EXPR (subj), NIL) + FI + FI + END; + + # Body of trans stmt. # + IF tok = name + THEN lab := HEAP IDR; idr addr OF lab := psn; scan; + IF tok = blank + THEN move to subj + ELSE verify (eos); + STMT (lab, REF EXPR (NIL), NIL) + FI + ELIF tok = blank + THEN move to subj + ELSE verify (eos); + STMT (lab, REF EXPR (NIL), NIL) + FI + END; + + PROC trans gofield = REF GOTOFIELD: + BEGIN PROC where = REF DEST: + BEGIN HEAP DEST d; + verify (lpar); + IF tok = blank THEN scan FI; + d := (tok = endt | scan; "E" + |: tok = ret | scan; "R" + |: tok = fret | scan; "F" + | trans expr); + verify (rpar); + d + END; + + REF DEST uncond := NIL, succ := NIL, fail := NIL; + scan; IF tok = blank THEN scan FI; + IF tok = stok + THEN scan; succ := where; + IF tok = blank THEN scan FI; + IF tok = ftok THEN scan; fail := where FI; + verify (eos) + ELIF tok = ftok + THEN scan; fail := where; + IF tok = blank THEN scan FI; + IF tok = stok THEN scan; succ := where FI; + verify (eos) + ELSE uncond := where; verify (eos) + FI; + HEAP GOTOFIELD := (uncond, succ, fail) + END; + + PROC trans expr = REF EXPR: + BEGIN REF EXPR e := trans expr1; + WHILE tok = bbar + DO scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans expr1, "!") + OD; + e + END; + + PROC trans expr1 = REF EXPR: + BEGIN REF EXPR e := trans expr2; + WHILE tok = blank + DO scan; + IF tok /= colon AND tok /= rpar AND tok /= comma AND tok /= equal + THEN e := HEAP EXPR := HEAP BINARYEXPR := (e, trans expr2, "C") + FI + OD; + e + END; + + PROC trans expr2 = REF EXPR: + BEGIN REF EXPR e := trans term; + CHAR opr; + WHILE tok = bplus OR tok = bminus + DO opr := (tok = bplus | "+" | "-"); + scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term, opr) + OD; + e + END; + + PROC trans term = REF EXPR: + BEGIN REF EXPR e := trans term1; + WHILE tok = bslash + DO scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term1, "/") + OD; + e + END; + + PROC trans term1 = REF EXPR: + BEGIN REF EXPR e := trans term2; + WHILE tok = bstar + DO scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term2, "*") + OD; + e + END; + + PROC trans term2 = REF EXPR: + BEGIN REF EXPR e := trans elem; + WHILE tok = bdoll + DO scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans elem, "$") + OD; + e + END; + + PROC trans elem = REF EXPR: + IF tok = doll OR tok = plus OR tok = minus OR tok = at + THEN CHAR opr = tok; + scan; + HEAP EXPR := HEAP UNARYEXPR := (trans element, opr) + ELSE trans element + FI; + + PROC trans element = REF EXPR: + IF tok = name + THEN IDR n; + idr addr OF n := psn; + scan; + IF tok /= lpar + THEN HEAP EXPR := n + ELSE HEAP[1:arglim]REF EXPR a, INT ac := 0; + WHILE scan; + IF tok = blank THEN scan FI; + IF ac = arglim + THEN error ("TOO MANY ARGUMENTS IN FUNCTION CALL") + FI; + IF NOT (ac = 0 AND tok = rpar) + THEN a[ac +:= 1] := (tok = comma OR tok = rpar | NIL | trans expr) + FI; + IF tok /= comma AND tok /= rpar + THEN error ("ERROR IN ARGUMENT LIST") + FI; + tok = comma + DO SKIP OD; + scan; + HEAP EXPR := HEAP CALL := (n, a[1:ac]) + FI + ELIF tok = lstring + THEN LSTR ls; + lstr addr OF ls := psn; + scan; + HEAP EXPR := ls + ELIF tok = number + THEN NUM nu; num addr OF nu := psn; + scan; + HEAP EXPR := nu + ELSE verify (lpar); + IF tok = blank THEN scan FI; + REF EXPR e = trans expr; + verify (rpar); + e + FI; + + PROC usage = VOID: + BEGIN puts ("Usage: snobol [-l] FILE'n"); + stop + END; + + listing := FALSE; + IF argc < 2 THEN usage FI; + FOR i FROM 2 TO argc + DO IF argv (i) = "-l" THEN listing := TRUE + ELIF filein = 0 + THEN filein := fopen (argv (i), file o rdonly); + IF (filein = -1) + THEN error ("opening " + argv (i) + ": " + strerror (errno)) FI + ELSE usage + FI + OD; + init; + translate + END; # TRANSLATION PHASE # + + BEGIN # INTERPRETATION PHASE # + + OP INTG = (REF ITEM a) INT: (a | (INT i) : i), + STR = (REF ITEM a) REF STRINGITEM: (a | (REF STRINGITEM s): s), + PAT = (REF ITEM a) PATTERN: (a | (PATTERN p) : p); + BOOL fn success; + + PROC interpret = (INT stmt no) VOID: + BEGIN INT sn := stmt no; BOOL cycling := TRUE; + + PROC jump = (REF DEST dest) VOID: + BEGIN failed := FALSE; + CASE dest + IN (REF EXPR e): sn := find label (eval softly (e)), + (CHAR c): IF c = "E" THEN sn := UPB t + 1 + ELIF c = "R" THEN fn success := TRUE; + cycling := FALSE + ELSE # c = "F" # fn success := cycling := FALSE + FI + ESAC + END; + + WHILE cycling + DO IF sn > UPB t THEN stop FI; + failed := FALSE; + + # EXECUTE STATEMENT CORE # + CASE stmt core OF t[sn] + IN (REF ASMT a): + (REF ITEM sp = eval softly (subject OF a); + assign (sp, eval strongly (object OF a))), + (REF MATCH m): + (REF ITEM svp = eval strongly (subject OF m); + match (convert to str (svp), + convert to pat (eval strongly (pattern OF m)))), + (REF REPL r): + (REF ITEM sp = eval softly (subject OF r); + REF ITEM pp = convert to pat (eval strongly (pattern OF r)); + REF ITEM svp = convert to str (ref OF (STR sp)); + INT c = match (svp, pp); + REF ITEM b = (svp IS NIL | NIL | make str ((val OF (STR svp))[c+1:])); + REF ITEM obp = eval strongly (object OF r); + assign (sp, concatenate (obp, b))), + (REF EXPR e): + eval strongly (e) + ESAC; + + # PROCESS GOTO FIELD # + REF GOTOFIELD go = goto OF t[sn]; + IF go IS NIL THEN sn := sn + 1 + ELIF REF DEST (upart OF go) ISNT NIL + THEN jump (upart OF go) + ELIF NOT failed AND (REF DEST (spart OF go) ISNT NIL) + THEN jump (spart OF go) + ELIF failed AND (REF DEST (fpart OF go) ISNT NIL) + THEN jump (fpart OF go) + ELSE sn := sn + 1 + FI + OD + END; # END OF INTERPRET # + + PROC find label = (REF ITEM label ptr) INT: + BEGIN INT stmt no := 0; + IF failed THEN error ("FAILURE IN GOTO FIELD") FI; + FOR i TO UPB t WHILE stmt no = 0 + DO IF (REF IDR (label OF t[i]) IS NIL + | FALSE + | label ptr IS idr addr OF label OF t[i]) + THEN stmt no := i + FI + OD; + IF stmt no = 0 THEN error ("UNDEFINED LABEL") FI; + stmt no + END; + + PROC match = (REF ITEM subject ptr, pattern ptr) INT: + IF failed + THEN 0 + ELSE PATTERN p = PAT pattern ptr; + STRING subj = (subject ptr IS NIL | "" | val OF (STR subject ptr)); + INT u = UPB subj; + INT iarg, # INTEGER COMPONENT ARGUMENT # + STRING sarg, # STRING COMPONENT ARGUMENT # + INT l; # LENGTH OF SARG # + INT cn := 1, # COMPONENT NUMBER # + c := 0, # CURSOR # + code; # NEW CURSOR OR -1 IF COMPONENT NO-MATCH # + BOOL matching := TRUE; + + psp := 0; # CLEAR PATTERN STACK # + WHILE matching + DO IF alternate OF p[cn] /= 0 + THEN # PUSH PATTERN STACK # + pattern stack[psp +:= 1] := (c, alternate OF p[cn]) + FI; + IF REF ITEM (arg OF p[cn]) ISNT NIL + THEN CASE arg OF p[cn] + IN (INT i) : iarg := i, + (REF STRINGITEM s): + (sarg := val OF s; l := UPB sarg) + ESAC + FI; + + # EXECUTE INDICATED MATCHING ROUTINE # + CASE routine OF p[cn] + IN # MSTR # + IF REF ITEM (arg OF p[cn]) IS NIL + THEN code := c + ELIF c + l > u THEN code := -1 + ELSE code := (sarg = subj[c+1:c+l] | c + l | -1) + FI, + # MLEN # + code := (iarg <= u - c | c + iarg | -1), + # MBRK # + IF c >= u THEN code := -1 + ELSE INT n = break scan (subj[c+1:], sarg); + code := (n < u - c | c + n | -1) + FI, + # MSPN # + IF c >= u THEN code := -1 + ELIF any (sarg, subj[c+1]) + THEN INT j := c + 1; + FOR i FROM c + 2 TO u WHILE any (sarg, subj[i]) + DO j := i OD; + code := j + ELSE code := -1 + FI, + # MANY # + IF c >= u + THEN code := -1 + ELSE code := (any (sarg, subj[c+1]) | c + 1 | -1) + FI, + # MNUL # + code := c, + # MIV1 # + code := extra OF p[cn] := c, + # MIV2 # + (INT m = extra OF p[cn - extra OF p[cn]] + 1; + assign (arg OF p[cn], make str (subj[m:c])); + code := c), + # M1 # + code := (1 <= u - c | c + 1 | -1), + # MAT # + (assign (arg OF p[cn], make int (c)); + code := c), + # MPOS # + code := (c = iarg | c | -1), + # MTAB # + code := (c <= iarg AND iarg <= u | iarg | -1), + # MRPOS # + code := (u - c = iarg | c | -1), + # MRTAB # + code := (u - c >= iarg | u - iarg | -1), + # MNTY # + IF c >= u + THEN code := -1 + ELSE code := (any (sarg, subj[c+1]) | -1 | c + 1) + FI + ESAC; + + # DECIDE WHAT TO DO NEXT # + IF code >= 0 + THEN IF subsequent OF p[cn] = 0 + THEN matching := FALSE #SUCCESSFUL TERMINATION # + ELSE cn := subsequent OF p[cn]; + c := code # CONTINUE # + FI + ELIF psp = 0 + THEN failed := TRUE; + matching := FALSE # STMT FAILURE # + ELSE # POP PATTERN STACK TO BACKTRACK # + cn := alternate OF pattern stack[psp]; + c := cursor OF pattern stack[psp]; + psp := psp - 1 + FI + OD; + (failed | 0 | code) + FI; # END OF MATCH PROCEDURE # + + PROC assign = (REF ITEM subject ptr, object ptr) VOID: + IF failed THEN SKIP + ELSE REF STRINGITEM s = STR subject ptr; + ref OF s := object ptr; + IF val OF s = "OUTPUT" + THEN IF object ptr IS NIL + THEN puts ("'n") + ELSE CASE object ptr + IN (REF STRINGITEM r): puts ((val OF r) + "'n"), + (INT i): puts (itoa (i) + "'n"), + (PATTERN): (error ("ATTEMPT TO OUTPUT PATTERN"); SKIP) + ESAC + FI + FI + FI; + + PROC eval softly = (REF EXPR expression) REF ITEM: + IF failed THEN SKIP + ELSE CASE expression # CAN NEVER BE NIL # + IN (IDR id): idr addr OF id, + (REF UNARYEXPR ue): + IF operator OF ue = "$" + THEN REF ITEM r = convert to str (eval strongly (operand OF ue)); + IF r IS NIL + THEN error ("NULL RESULT WHERE VAR REQUIRED"); + SKIP + ELSE r + FI + ELSE error ("INAPPROPRIATE UNARY EXPR WHERE VAR REQUIRED"); + SKIP + FI + OUT error ("INAPPROPRIATE EXPR WHERE VAR REQUIRED"); + SKIP + ESAC + FI; + + PROC eval strongly = (REF EXPR expression) REF ITEM: + IF failed THEN SKIP + ELIF expression IS NIL THEN NIL + ELSE CASE expression + IN (IDR id): + (REF STRINGITEM s = STR (idr addr OF id); + IF val OF s = "INPUT" + THEN STRING line; + # SNOBOL programs read data from stdin. # + line := gets (80); + IF (line = "") THEN failed := TRUE; eof FI; + assign (idr addr OF id, make str (line)); + eof: SKIP + FI; + ref OF s), + (NUM nbr): + num addr OF nbr, + (LSTR ls): + lstr addr OF ls, + (REF UNARYEXPR ue): + (REF ITEM arg ptr = (operator OF ue = "@" + | eval softly (operand OF ue) + | eval strongly (operand OF ue)); + eval unary (arg ptr, operator OF ue)), + (REF BINARYEXPR be): + (REF ITEM arg1 ptr = eval strongly (operand1 OF be); + REF ITEM arg2 ptr = (operator OF be = "$" + | eval softly (operand2 OF be) + | eval strongly (operand2 OF be)); + eval binary (arg1 ptr, arg2 ptr, operator OF be)), + (REF CALL cl): + (INT n = UPB args OF cl; + [1:n]REF ITEM arglist; + FOR i TO n + DO arglist[i] := eval strongly ((args OF cl)[i]) OD; + eval call (idr addr OF fnname OF cl, arglist)) + ESAC + FI; + + PROC eval unary = (REF ITEM arg ptr, CHAR opr) REF ITEM: + IF failed THEN SKIP + ELSE IF opr = "$" + THEN IF arg ptr IS NIL + THEN error ("INDIRECTION APPLIED TO NULL STRING"); + SKIP + ELSE ref OF (STR convert to str (arg ptr)) + FI + ELIF opr = "+" + THEN convert to int (arg ptr) + ELIF opr = "-" + THEN INT k = INTG convert to int (arg ptr); + make int (-k) + ELSE # OPR = "@" # + make pat comp (mat, arg ptr) + FI + FI; + + PROC eval binary = (REF ITEM arg1 ptr, arg2 ptr, CHAR opr) REF ITEM: + IF failed THEN SKIP + ELSE IF opr = "$" + THEN REF ITEM c = concatenate (make pat comp (miv1, NIL), + arg1 ptr); + concatenate (c, make pat comp (miv2, arg2 ptr)) + ELIF opr = "*" OR opr = "/" OR opr = "+" OR opr = "-" + THEN INT m = INTG convert to int (arg1 ptr), + n = INTG convert to int (arg2 ptr); + make int ((opr = "*" | m * n + |: opr = "/" | m OVER n + |: opr = "+" | m + n | m - n)) + ELIF opr = "C" + THEN concatenate (arg1 ptr, arg2 ptr) + ELSE # OPR = "!" # + PATTERN p1 = PAT convert to pat (arg1 ptr), + p2 = PAT convert to pat (arg2 ptr); + INT u1 = UPB p1, u2 = UPB p2; + PATTERN p = HEAP[u1 + u2]COMPONENT, + INT offset = u1 + 1, INT j := 1; + p[1:u1] := p1[1:u1]; + WHILE alternate OF p[j] /= 0 + DO j := alternate OF p[j] OD; + alternate OF p[j] := offset; + FOR i FROM offset TO u1 + u2 + DO p[i] := p2 [i - u1]; + IF subsequent OF p[i] /= 0 + THEN subsequent OF p[i] +:= u1 + FI; + IF alternate OF p[i] /= 0 + THEN alternate OF p[i] +:= u1 + FI + OD; + HEAP ITEM := p + FI + FI; + + PROC eval call = (REF ITEM name ptr, REF[]REF ITEM arglist) REF ITEM: + IF failed THEN SKIP + ELSE # SEARCH FUNCTION TABLE FOR NAME # + BOOL not found := TRUE, INT j; + FOR i TO ftp WHILE not found + DO IF name ptr IS fnname OF function table[i] + THEN j := i; not found := FALSE + FI + OD; + IF not found + THEN exec prim fn (name ptr, arglist) + ELSE #PROGRAMMER-DEFINED FUNCTION # + + PROC stack = (REF ITEM a) VOID: + (IF rsp = rslim THEN error ("RUN STACK OVERFLOW") FI; + run stack [rsp +:= 1] := a); + + PROC unstack = REF ITEM: + (IF rsp = 0 THEN error ("RETURN FROM LEVEL 0") FI; + run stack [(rsp -:= 1) + 1]); + + REF STRINGITEM name = STR name ptr; + + # ENTRY PROTOCOL # + stack (ref OF name); + assign (name ptr, NIL); + REF[]REF ITEM params = params OF function table[j], + INT n = UPB arglist; + IF UPB params /= n + THEN error ("WRONG NUMBER OF ARGUMENTS IN CALL") + FI; + FOR i TO n + DO stack (ref OF (STR params[i])); + assign (params[i], arglist[i]) + OD; + REF[]REF ITEM locals = locals OF function table[j]; + FOR i TO UPB locals + DO stack (ref OF (STR locals[i])); + assign (locals[i], NIL) + OD; + + interpret (find label (entry name OF function table[j])); + + # RETURN PROTOCOL # + FOR i FROM UPB locals BY -1 TO 1 + DO assign (locals[i], unstack) OD; + FOR i FROM n BY -1 TO 1 + DO assign (params[i], unstack) OD; + REF ITEM result = ref OF name; + assign (name ptr, unstack); + (fn success | result | failed := TRUE ; SKIP) + FI + FI; + + PROC exec prim fn = (REF ITEM name ptr, + REF[]REF ITEM arglist) REF ITEM: + BEGIN + PROC gen1 = (INT routine) REF ITEM: + BEGIN # CREATE PATTERN COMPONENT WITH STRING ARGUMENT # + REF ITEM arg = convert to str (arglist[1]); + IF arg IS NIL + THEN error ("NULL ARG FOR PATTERN-VALUED PRIMITIVE FUNCTION" ) + FI; + make pat comp (routine, arg) + END; + + PROC gen2 = (INT routine) REF ITEM: + BEGIN # CREATE PATTERN COMPONENT WITH INTEGER ARGUMENT # + REF ITEM arg = convert to int (arglist[1]); + IF INTG arg < 0 + THEN error ("NEGATIVE ARG FOR PATTERN-VALUED PRIMITIVE FUNCTION") + FI; + make pat comp (routine, arg) + END; + + STRING fn = val OF (STR name ptr), INT n = UPB arglist; + IF fn = "LE" AND n = 2 + THEN IF INTG convert to int (arglist[1]) + <= INTG convert to int (arglist[2]) + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "EQ" AND n = 2 + THEN IF INTG convert to int (arglist[1]) + = INTG convert to int (arglist[2]) + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "NE" AND n = 2 + THEN IF INTG convert to int (arglist[1]) + /= INTG convert to int (arglist[2]) + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "IDENT" AND n = 2 + THEN IF REF ITEM (arglist[1]) IS arglist[2] + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "DIFFER" AND n = 2 + THEN IF REF ITEM (arglist[1]) ISNT arglist[2] + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "ANY" AND n = 1 THEN gen1 (many) + ELIF fn = "LEN" AND n = 1 THEN gen2 (mlen) + ELIF fn = "POS" AND n = 1 THEN gen2 (mpos) + ELIF fn = "TAB" AND n = 1 THEN gen2 (mtab) + ELIF fn = "SPAN" AND n = 1 THEN gen1 (mspn) + ELIF fn = "RPOS" AND n = 1 THEN gen2 (mrpos) + ELIF fn = "RTAB" AND n = 1 THEN gen2 (mrtab) + ELIF fn = "BREAK" AND n = 1 THEN gen1 (mbrk) + ELIF fn = "NOTANY" AND n = 1 THEN gen1 (mnty) + ELIF fn = "SIZE" AND n = 1 + THEN make int (UPB val OF (STR convert to str (arglist[1]))) + ELIF fn = "DEFINE" AND n = 2 + THEN IF REF ITEM (arglist[1]) IS NIL + THEN error ("NULL PROTOTYPE") FI; + STRING prototype = val OF (STR convert to str (arglist[1])); + REF ITEM entry = convert to str (arglist[2]); + IF entry IS NIL THEN error ("NULL ENTRY LABEL") FI; + + PROC check and find = (STRING str) REF ITEM: + BEGIN IF UPB str = 0 THEN error ("ILLEGAL PROTOTYPE") FI; + STRING an = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789."; + IF NOT any (an[:26], str[1]) + THEN error ("ILLEGAL PROTOTYPE") FI; + FOR i FROM 2 TO UPB str + DO IF NOT any (an, str[i]) + THEN error ("ILLEGAL PROTOTYPE") + FI + OD; + make str (str) + END; + + PROC breakup = (STRING str) REF[]REF ITEM: + BEGIN #ANALYZE A LIST OF IDENTIFIERS # + [1:arglim]REF ITEM r, INT p := 0, a := 1, b; + WHILE a <= UPB str + DO b := break scan (str[a:], ","); + IF p >= arglim + THEN error ("TOO MANY PARAMETERS OR LOCALS IN PROTOTYPE") FI; + r[p +:= 1] := check and find (str[a:a+b-1]); + a := a + b + 1 + OD; + HEAP[1:p]REF ITEM := r[:p] + END; + + INT lp = UPB prototype; + INT a = break scan (prototype, "("); + IF a >= lp THEN error ("ILLEGAL PROTOTYPE") FI; + REF ITEM name ptr = check and find (prototype[:a]); + INT b = break scan (prototype[a+2:], ")"); + IF b >= lp - a - 1 THEN error ("ILLEGAL PROTOTYPE") FI; + REF[]REF ITEM params = breakup (prototype[a+2:a+1+b]); + REF[]REF ITEM locals = breakup (prototype[a+b+3:]); + + BOOL not found := TRUE; + FOR i TO ftp WHILE not found + DO IF name ptr IS fnname OF function table[i] + THEN not found := FALSE; + function table[i] := (name ptr, entry, params, locals) + FI + OD; + IF not found + THEN IF ftp = ftlim + THEN error ("FUNCTION TABLE OVERFLOW") FI; + function table [ftp +:= 1] := (name ptr, entry, params, locals) + FI; + NIL # RESULT OF DEFINE(...) # + ELSE error ("ILLEGAL FUNCTION CALL"); + SKIP + FI + END; + + PROC concatenate = (REF ITEM ptr1, ptr2) REF ITEM: + BEGIN + + PROC concat patterns = (PATTERN p1, p2) REF ITEM: + BEGIN INT u1 = UPB p1, u2 = UPB p2; + PATTERN p = HEAP[u1 + u2]COMPONENT; + INT offset = u1 + 1; + FOR i TO u1 + DO p[i] := p1[i]; + IF subsequent OF p[i] = 0 + THEN subsequent OF p[i] := offset FI + OD; + FOR i FROM offset TO u1 + u2 + DO p[i] := p2[i - u1]; + IF subsequent OF p[i] /= 0 + THEN subsequent OF p[i] +:= u1 FI; + IF alternate OF p[i] /= 0 + THEN alternate OF p[i] +:= u1 FI + OD; + IF u2 = 1 AND routine OF p[offset] = miv2 + THEN extra OF p[offset] := u1 FI; + HEAP ITEM := p + END; + + IF failed THEN SKIP + ELSE IF ptr1 IS NIL THEN ptr2 + ELIF ptr2 IS NIL THEN ptr1 + ELSE CASE ptr1 + IN (PATTERN p1): + concat patterns (p1, PAT convert to pat (ptr2)) + OUSE ptr2 + IN (PATTERN p2): + concat patterns (PAT convert to pat (ptr1), p2) + OUT STRING s1 = val OF (STR convert to str (ptr1)); + make str (s1 + val OF (STR convert to str (ptr2))) + ESAC + FI + FI + END; + + PROC convert to int = (REF ITEM ptr) REF ITEM: + IF failed THEN SKIP + ELSE IF ptr IS NIL THEN make int (0) + ELSE CASE ptr + IN (INT): ptr, + (PATTERN): (error ("PATTERN VALUE WHERE INTEGER REQUIRED"); SKIP), + (REF STRINGITEM s): + (INT n := 0, d, z := ABS "0"; + FOR i TO UPB val OF s + DO d := ABS (val OF s)[i] - z; + IF d < 0 OR d > 9 + THEN error ("STRING NOT CONVERTIBLE TO INTEGER") FI; + n := n * 10 + d + OD; + make int (n)) + ESAC + FI + FI; + + PROC convert to pat = (REF ITEM ptr) REF ITEM: + IF failed THEN SKIP + ELSE IF ptr IS NIL + THEN make pat comp (mstr, NIL) + ELSE CASE ptr + IN (PATTERN): ptr + OUT make pat comp (mstr, convert to str (ptr)) + ESAC + FI + FI; + + PROC convert to str = (REF ITEM ptr) REF ITEM: + IF failed THEN SKIP + ELSE IF ptr IS NIL THEN ptr + ELSE CASE ptr + IN (REF STRINGITEM): ptr, + (PATTERN): (error ("PATTERN VALUE WHERE STRING REQUIRED"); SKIP), + (INT i): make str (itoa (i)) + ESAC + FI + FI; + + PROC make int = (INT val) REF ITEM: + IF failed THEN SKIP + ELSE HEAP ITEM := val + FI; + + PROC make pat comp = (INT routine, REF ITEM arg) REF ITEM: + IF failed THEN SKIP + ELSE HEAP ITEM := HEAP[1:1]COMPONENT := COMPONENT (routine, 0, 0, SKIP, arg) + FI; + + PROC make str = (STRING val) REF ITEM: + IF failed THEN SKIP + ELIF UPB val = 0 THEN NIL + ELSE INT i := 0, BOOL nf := TRUE; + WHILE IF (i +:= 1) <= nin + THEN nf := val /= val OF (STR spool [i]) + ELSE FALSE + FI + DO SKIP OD; + IF nf + THEN IF nin = spoolsize THEN error ("TOO MANY STRINGS") FI; + spool[nin +:= 1] := HEAP ITEM := HEAP STRINGITEM := (val, NIL) + FI; + spool[i] + FI; + + PROC break scan = (STRING str, arg) INT: + BEGIN # RESULT = UPB STR IF NO BREAK CHAR, LESS OTHERWISE # + INT j := 0; + FOR i TO UPB str WHILE NOT any (arg, str[i]) + DO j := i OD; + j + END; + + PROC any = (STRING str, CHAR ch) BOOL: + BEGIN BOOL nf; + FOR i TO UPB str WHILE nf := ch /= str[i] DO SKIP OD; + NOT nf + END; + + interpret ((REF ITEM (prog entry) IS NIL | 1 | find label (prog entry))) + END # INTERPRETATION PHASE # +END diff --git a/gcc/testsuite/algol68/compile/supper-1.a68 b/gcc/testsuite/algol68/compile/supper-1.a68 new file mode 100644 index 00000000000..a572f1e929f --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-1.a68 @@ -0,0 +1,11 @@ +{ dg-options {-fstropping=supper} } + +begin mode Some_Mode = real; + Some_Mode some_real := random; + + puts ("Hello time for SUPPER!\n"); + if some_real > 0.5 + then puts ("YES\n") + else puts ("NO\n") + fi +end diff --git a/gcc/testsuite/algol68/compile/supper-10.a68 b/gcc/testsuite/algol68/compile/supper-10.a68 new file mode 100644 index 00000000000..5c661a677f4 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-10.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode BEGIN = int; + BEGIN some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-11.a68 b/gcc/testsuite/algol68/compile/supper-11.a68 new file mode 100644 index 00000000000..5c661a677f4 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-11.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode BEGIN = int; + BEGIN some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-12.a68 b/gcc/testsuite/algol68/compile/supper-12.a68 new file mode 100644 index 00000000000..497a88a2e66 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-12.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin for i while i < 10 + do puts ("lala\n") + od +end diff --git a/gcc/testsuite/algol68/compile/supper-13.a68 b/gcc/testsuite/algol68/compile/supper-13.a68 new file mode 100644 index 00000000000..5e17fb4832c --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-13.a68 @@ -0,0 +1,7 @@ +{ dg-options "-fstropping=supper" } + +{ mode_ should not be recognized as a symbol. } + +begin int mode_ = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-2.a68 b/gcc/testsuite/algol68/compile/supper-2.a68 new file mode 100644 index 00000000000..04d5f0f461f --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-2.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin int foo_bar = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-3.a68 b/gcc/testsuite/algol68/compile/supper-3.a68 new file mode 100644 index 00000000000..4cc711b9132 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-3.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin int foo_bar_ = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-4.a68 b/gcc/testsuite/algol68/compile/supper-4.a68 new file mode 100644 index 00000000000..283be9a4735 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-4.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin int foo_ = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-5.a68 b/gcc/testsuite/algol68/compile/supper-5.a68 new file mode 100644 index 00000000000..b3ffd899e5c --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-5.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode Foo_bar = int; + Foo_bar some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-6.a68 b/gcc/testsuite/algol68/compile/supper-6.a68 new file mode 100644 index 00000000000..37fc5e6f3c2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-6.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin go to done; +done: skip +end diff --git a/gcc/testsuite/algol68/compile/supper-7.a68 b/gcc/testsuite/algol68/compile/supper-7.a68 new file mode 100644 index 00000000000..a3741748b4c --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-7.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin goto done; +done: skip +end diff --git a/gcc/testsuite/algol68/compile/supper-8.a68 b/gcc/testsuite/algol68/compile/supper-8.a68 new file mode 100644 index 00000000000..363d9b483ca --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-8.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode Int = int; + Int some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-9.a68 b/gcc/testsuite/algol68/compile/supper-9.a68 new file mode 100644 index 00000000000..5c661a677f4 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-9.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode BEGIN = int; + BEGIN some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/uniting-1.a68 b/gcc/testsuite/algol68/compile/uniting-1.a68 new file mode 100644 index 00000000000..057c4f85838 --- /dev/null +++ b/gcc/testsuite/algol68/compile/uniting-1.a68 @@ -0,0 +1,8 @@ +{ dg-options {-fstropping=supper} } +begin mode JSON_Val = union (int,ref JSON_Obj), + JSON_Obj = struct (int je), + + proc json_new_obj = JSON_Val: + (JSON_Obj o; o); + skip +end diff --git a/gcc/testsuite/algol68/compile/upper-1.a68 b/gcc/testsuite/algol68/compile/upper-1.a68 new file mode 100644 index 00000000000..6fb7871301f --- /dev/null +++ b/gcc/testsuite/algol68/compile/upper-1.a68 @@ -0,0 +1,11 @@ +# { dg-options {-fstropping=upper} } # + +BEGIN MODE SOME_MODE = REAL; + SOME_MODE some_real := random; + + puts ("Hello time for SUPPER!\n"); + IF some_real > 0.5 + THEN puts ("YES\n") + ELSE puts ("NO\n") + FI +END diff --git a/gcc/testsuite/algol68/compile/warning-hidding-1.a68 b/gcc/testsuite/algol68/compile/warning-hidding-1.a68 new file mode 100644 index 00000000000..b3d568bf9a2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-1.a68 @@ -0,0 +1,6 @@ +{ dg-options "-Whidden-declarations" } +begin + op UPB = (union (int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-2.a68 b/gcc/testsuite/algol68/compile/warning-hidding-2.a68 new file mode 100644 index 00000000000..12bfcbbc63f --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-2.a68 @@ -0,0 +1,6 @@ +{ dg-options "-Whidden-declarations" } +begin + op UPB = (union ([]int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-3.a68 b/gcc/testsuite/algol68/compile/warning-hidding-3.a68 new file mode 100644 index 00000000000..25f4809ebcf --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-3.a68 @@ -0,0 +1,5 @@ +{ dg-options "-Whidden-declarations" } +begin op UPB = (union (int,union(string,real)) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-4.a68 b/gcc/testsuite/algol68/compile/warning-hidding-4.a68 new file mode 100644 index 00000000000..0078e6a593f --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-4.a68 @@ -0,0 +1,6 @@ +{ dg-options "-Whidden-declarations" } +begin + op UPB = (int i, union (int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-5.a68 b/gcc/testsuite/algol68/compile/warning-hidding-5.a68 new file mode 100644 index 00000000000..f9bc4a41ea4 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-5.a68 @@ -0,0 +1,9 @@ +{ dg-options "-Whidden-declarations=none" } +begin real b; + begin int getchar = 10; + int b; + op UPB = (int i, union (int,string) v) int: + (v | (string s): UPB s | 0); + UPB "lala" + end +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-6.a68 b/gcc/testsuite/algol68/compile/warning-hidding-6.a68 new file mode 100644 index 00000000000..a865103bcdf --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-6.a68 @@ -0,0 +1,9 @@ +{ dg-options "-Whidden-declarations=prelude" } +begin real b; + begin int getchar = 10; { dg-warning "hides" } + int b; + op UPB = (int i, union (int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" + end +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-7.a68 b/gcc/testsuite/algol68/compile/warning-hidding-7.a68 new file mode 100644 index 00000000000..e641a93934e --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-7.a68 @@ -0,0 +1,9 @@ +{ dg-options "-Whidden-declarations=all" } +begin real b; + begin int getchar = 10; { dg-warning "hides" } + int b; { dg-warning "hides" } + op UPB = (int i, union (int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" + end +end diff --git a/gcc/testsuite/algol68/compile/warning-module-hidding-1.a68 b/gcc/testsuite/algol68/compile/warning-module-hidding-1.a68 new file mode 100644 index 00000000000..84b4b0e25b2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-module-hidding-1.a68 @@ -0,0 +1,6 @@ +{ dg-options "-Whidden-declarations=all" } + +module Foo = def int i; i := 10 postlude puts ("bye foo'n") fed, + Bar = def int j; j := 20 + postlude int j; puts ("bye bar'n") fed, { dg-warning "hidden" } + Baz = def skip fed diff --git a/gcc/testsuite/algol68/compile/warning-pub-loc-1.a68 b/gcc/testsuite/algol68/compile/warning-pub-loc-1.a68 new file mode 100644 index 00000000000..57baef93eca --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-pub-loc-1.a68 @@ -0,0 +1,7 @@ +module Foo = +def pub ref int xx = loc int := 777; { dg-warning "" } + pub ref int yy; + pub ref int zz = heap int := 888; + ref int vv = loc int := 999; + skip +fed diff --git a/gcc/testsuite/algol68/compile/warning-scope-1.a68 b/gcc/testsuite/algol68/compile/warning-scope-1.a68 new file mode 100644 index 00000000000..99ae973fe90 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # + +# Potential scope violation warnings are disabled by default. # +BEGIN PROC increase = (REF INT i) REF INT: + BEGIN INT j := i; + j # Inhibited warning. # + END; + increase (LOC INT) +END diff --git a/gcc/testsuite/algol68/compile/warning-scope-2.a68 b/gcc/testsuite/algol68/compile/warning-scope-2.a68 new file mode 100644 index 00000000000..5bbc0b37126 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-2.a68 @@ -0,0 +1,8 @@ +# { dg-options {-Wscope -fstropping=upper} } # +BEGIN PROC increase = (REF INT i) REF INT: + BEGIN + INT j := i; + j # { dg-warning "scope violation" } # + END; + increase (LOC INT) +END diff --git a/gcc/testsuite/algol68/compile/warning-scope-3.a68 b/gcc/testsuite/algol68/compile/warning-scope-3.a68 new file mode 100644 index 00000000000..c5dd29562c0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-3.a68 @@ -0,0 +1,3 @@ +# { dg-options {-Wscope -fstropping=upper} } # +(REF INT xx; + xx := (INT x; x := 3)) # { dg-warning "scope violation" } # diff --git a/gcc/testsuite/algol68/compile/warning-scope-4.a68 b/gcc/testsuite/algol68/compile/warning-scope-4.a68 new file mode 100644 index 00000000000..ae0592ed743 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-4.a68 @@ -0,0 +1,3 @@ +# { dg-options {-Wscope -fstropping=upper} } # +(REF INT xx; + (INT x; xx:= x; x := 3)) # { dg-warning "scope violation" } # diff --git a/gcc/testsuite/algol68/compile/warning-scope-5.a68 b/gcc/testsuite/algol68/compile/warning-scope-5.a68 new file mode 100644 index 00000000000..2bb5b4afe88 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-5.a68 @@ -0,0 +1,8 @@ +# { dg-options {-Wscope -fstropping=upper} } # +# The scope violation here is due to the routine text, which is copied + to P, referring to a value whose range doesn't exist anymore: X # +BEGIN (PROC REAL p; + (REAL x; + p := REAL: x * 2); # { dg-warning "scope violation" } # + p) +END diff --git a/gcc/testsuite/algol68/compile/warning-scope-6.a68 b/gcc/testsuite/algol68/compile/warning-scope-6.a68 new file mode 100644 index 00000000000..fa3888d6528 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-6.a68 @@ -0,0 +1,6 @@ +# { dg-options {-Wscope -fstropping=upper} } # +BEGIN (PROC REAL p; REAL mypi := 3.14; + (REAL x; + p := REAL: mypi * 2); # No scope violation here. # + p) +END diff --git a/gcc/testsuite/algol68/compile/warning-scope-7.a68 b/gcc/testsuite/algol68/compile/warning-scope-7.a68 new file mode 100644 index 00000000000..b99fa85ddff --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-7.a68 @@ -0,0 +1,12 @@ +# { dg-options {-Wscope -fstropping=upper} } # +# N,M below represent pairs of insc, outsc # +BEGIN (INT x; + REF INT xx; + (REF INT yy; + INT y; + xx := yy; # 0,0 := 1,0. Dynamic check. # + yy := y; # 1,1 := 1,1. OK # + xx := y # 0,0 := 1,1. { dg-warning "scope violation" } # + ) + ) +END diff --git a/gcc/testsuite/algol68/compile/warning-voiding-1.a68 b/gcc/testsuite/algol68/compile/warning-voiding-1.a68 new file mode 100644 index 00000000000..f34787c2979 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-voiding-1.a68 @@ -0,0 +1,5 @@ +# { dg-options {-Wvoiding -fstropping=upper} } # +BEGIN PROC sum = (INT a, INT b) INT: + ( a + b ); + sum (10, 20) # { dg-warning "will be voided" } # +END diff --git a/gcc/testsuite/algol68/compile/warning-voiding-2.a68 b/gcc/testsuite/algol68/compile/warning-voiding-2.a68 new file mode 100644 index 00000000000..e3c98792c91 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-voiding-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN PROC sum = (INT a, INT b) INT: + ( a + b ); + sum (10, 20) # Voiding warning won't be emitted by default. # +END