From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/a/a22006b.ada | 38 ++++ gcc/testsuite/ada/acats/tests/a/a22006c.ada | 51 +++++ gcc/testsuite/ada/acats/tests/a/a22006d.ada | 41 ++++ gcc/testsuite/ada/acats/tests/a/a26007a.tst | 48 +++++ gcc/testsuite/ada/acats/tests/a/a27003a.ada | 51 +++++ gcc/testsuite/ada/acats/tests/a/a29003a.ada | 102 ++++++++++ gcc/testsuite/ada/acats/tests/a/a2a031a.ada | 72 ++++++++ gcc/testsuite/ada/acats/tests/a/a33003a.ada | 49 +++++ gcc/testsuite/ada/acats/tests/a/a34017c.ada | 105 +++++++++++ gcc/testsuite/ada/acats/tests/a/a35101b.ada | 50 +++++ gcc/testsuite/ada/acats/tests/a/a35402a.ada | 63 +++++++ gcc/testsuite/ada/acats/tests/a/a35801f.ada | 64 +++++++ gcc/testsuite/ada/acats/tests/a/a35902c.ada | 51 +++++ gcc/testsuite/ada/acats/tests/a/a38106d.ada | 99 ++++++++++ gcc/testsuite/ada/acats/tests/a/a38106e.ada | 99 ++++++++++ gcc/testsuite/ada/acats/tests/a/a49027a.ada | 85 +++++++++ gcc/testsuite/ada/acats/tests/a/a49027b.ada | 159 ++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a49027c.ada | 70 +++++++ gcc/testsuite/ada/acats/tests/a/a54b01a.ada | 119 ++++++++++++ gcc/testsuite/ada/acats/tests/a/a54b02a.ada | 184 ++++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a55b12a.ada | 147 +++++++++++++++ gcc/testsuite/ada/acats/tests/a/a55b13a.ada | 128 +++++++++++++ gcc/testsuite/ada/acats/tests/a/a55b14a.ada | 112 +++++++++++ gcc/testsuite/ada/acats/tests/a/a71004a.ada | 130 +++++++++++++ gcc/testsuite/ada/acats/tests/a/a73001i.ada | 73 ++++++++ gcc/testsuite/ada/acats/tests/a/a73001j.ada | 78 ++++++++ gcc/testsuite/ada/acats/tests/a/a74105b.ada | 78 ++++++++ gcc/testsuite/ada/acats/tests/a/a74106a.ada | 168 +++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a74106b.ada | 159 ++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a74106c.ada | 155 ++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a74205e.ada | 149 +++++++++++++++ gcc/testsuite/ada/acats/tests/a/a74205f.ada | 93 ++++++++++ gcc/testsuite/ada/acats/tests/a/a83009a.ada | 198 ++++++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a83009b.ada | 196 ++++++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a83a02a.ada | 120 ++++++++++++ gcc/testsuite/ada/acats/tests/a/a83a02b.ada | 116 ++++++++++++ gcc/testsuite/ada/acats/tests/a/a83a06a.ada | 94 ++++++++++ gcc/testsuite/ada/acats/tests/a/a83a08a.ada | 102 ++++++++++ gcc/testsuite/ada/acats/tests/a/a83c01c.ada | 83 +++++++++ gcc/testsuite/ada/acats/tests/a/a83c01h.ada | 99 ++++++++++ gcc/testsuite/ada/acats/tests/a/a83c01i.ada | 112 +++++++++++ gcc/testsuite/ada/acats/tests/a/a85007d.ada | 156 ++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a85013b.ada | 89 +++++++++ gcc/testsuite/ada/acats/tests/a/a87b59a.ada | 250 +++++++++++++++++++++++++ gcc/testsuite/ada/acats/tests/a/a95001c.ada | 74 ++++++++ gcc/testsuite/ada/acats/tests/a/a95074d.ada | 82 ++++++++ gcc/testsuite/ada/acats/tests/a/a97106a.ada | 86 +++++++++ gcc/testsuite/ada/acats/tests/a/a99006a.ada | 66 +++++++ gcc/testsuite/ada/acats/tests/a/aa2010a.ada | 199 ++++++++++++++++++++ gcc/testsuite/ada/acats/tests/a/aa2012a.ada | 70 +++++++ gcc/testsuite/ada/acats/tests/a/ac1015b.ada | 81 ++++++++ gcc/testsuite/ada/acats/tests/a/ac3106a.ada | 216 ++++++++++++++++++++++ gcc/testsuite/ada/acats/tests/a/ac3206a.ada | 120 ++++++++++++ gcc/testsuite/ada/acats/tests/a/ac3207a.ada | 92 +++++++++ gcc/testsuite/ada/acats/tests/a/ad7001b.ada | 66 +++++++ gcc/testsuite/ada/acats/tests/a/ad7001c0.ada | 65 +++++++ gcc/testsuite/ada/acats/tests/a/ad7001c1.ada | 60 ++++++ gcc/testsuite/ada/acats/tests/a/ad7001d0.ada | 60 ++++++ gcc/testsuite/ada/acats/tests/a/ad7001d1.ada | 55 ++++++ gcc/testsuite/ada/acats/tests/a/ad7006a.ada | 47 +++++ gcc/testsuite/ada/acats/tests/a/ad7101a.ada | 51 +++++ gcc/testsuite/ada/acats/tests/a/ad7101c.ada | 50 +++++ gcc/testsuite/ada/acats/tests/a/ad7102a.ada | 50 +++++ gcc/testsuite/ada/acats/tests/a/ad7103a.ada | 50 +++++ gcc/testsuite/ada/acats/tests/a/ad7103c.ada | 50 +++++ gcc/testsuite/ada/acats/tests/a/ad7104a.ada | 50 +++++ gcc/testsuite/ada/acats/tests/a/ad7201a.ada | 98 ++++++++++ gcc/testsuite/ada/acats/tests/a/ad7203b.ada | 267 +++++++++++++++++++++++++++ gcc/testsuite/ada/acats/tests/a/ad7205b.ada | 64 +++++++ gcc/testsuite/ada/acats/tests/a/ad8011a.tst | 64 +++++++ gcc/testsuite/ada/acats/tests/a/ada101a.ada | 101 ++++++++++ gcc/testsuite/ada/acats/tests/a/ae2113a.ada | 120 ++++++++++++ gcc/testsuite/ada/acats/tests/a/ae2113b.ada | 120 ++++++++++++ gcc/testsuite/ada/acats/tests/a/ae3002g.ada | 47 +++++ gcc/testsuite/ada/acats/tests/a/ae3101a.ada | 135 ++++++++++++++ gcc/testsuite/ada/acats/tests/a/ae3702a.ada | 59 ++++++ gcc/testsuite/ada/acats/tests/a/ae3709a.ada | 56 ++++++ 77 files changed, 7556 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/a/a22006b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a22006c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a22006d.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a26007a.tst create mode 100644 gcc/testsuite/ada/acats/tests/a/a27003a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a29003a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a2a031a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a33003a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a34017c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a35101b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a35402a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a35801f.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a35902c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a38106d.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a38106e.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a49027a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a49027b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a49027c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a54b01a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a54b02a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a55b12a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a55b13a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a55b14a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a71004a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a73001i.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a73001j.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a74105b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a74106a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a74106b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a74106c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a74205e.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a74205f.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83009a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83009b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83a02a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83a02b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83a06a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83a08a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83c01c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83c01h.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a83c01i.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a85007d.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a85013b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a87b59a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a95001c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a95074d.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a97106a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/a99006a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/aa2010a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/aa2012a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ac1015b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ac3106a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ac3206a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ac3207a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7001b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7001c0.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7001c1.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7001d0.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7001d1.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7006a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7101a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7101c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7102a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7103a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7103c.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7104a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7201a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7203b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad7205b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ad8011a.tst create mode 100644 gcc/testsuite/ada/acats/tests/a/ada101a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ae2113a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ae2113b.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ae3002g.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ae3101a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ae3702a.ada create mode 100644 gcc/testsuite/ada/acats/tests/a/ae3709a.ada (limited to 'gcc/testsuite/ada/acats/tests/a') diff --git a/gcc/testsuite/ada/acats/tests/a/a22006b.ada b/gcc/testsuite/ada/acats/tests/a/a22006b.ada new file mode 100644 index 000000000..250caf2d6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a22006b.ada @@ -0,0 +1,38 @@ +-- A22006B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT HORIZONTAL TABULATION CAN BE USED WITHIN AND OUTSIDE OF +-- COMMENTS. + +-- JBG 5/26/85 + +WITH REPORT; USE REPORT; +PROCEDURE A22006B IS +BEGIN + TEST ("A22006B", "CHECK USE OF HT IN AND OUT OF COMMENTS"); + -- PRECEDING LINE CONTAINED A LEADING HT + -- NEXT LINE CONTAINS A TAB INSIDE A COMMENT + -- HERE IS HT => <= CHARACTER IN A COMMENT + RESULT; -- TAB PRECEDES THIS COMMENT +END A22006B; diff --git a/gcc/testsuite/ada/acats/tests/a/a22006c.ada b/gcc/testsuite/ada/acats/tests/a/a22006c.ada new file mode 100644 index 000000000..e04eb1223 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a22006c.ada @@ -0,0 +1,51 @@ + + + +-- A22006C.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A COMPILATION MAY BE PRECEDED BY EXTRA LINES +-- (INCLUDING LINES TERMINATED BY FORMAT EFFECTORS OTHER +-- THAN HORIZONTAL TABULATION). + +-- NOTE: THIS FILE BEGINS WITH: +-- 1) AN EMPTY LINE +-- 2) A CARRIAGE RETURN CHARACTER (ASCII 13. = 0D HEX) +-- 3) A CARRIAGE RETURN CHARACTER (ASCII 13. = 0D HEX) +-- 4) A VERTICAL TABULATION CHARACTER (ASCII 11. = 0B HEX) +-- 5) A LINE FEED CHARACTER (ASCII 10. = 0A HEX) +-- 6) A LINE FEED CHARACTER (ASCII 10. = 0A HEX) +-- 7) A FORM FEED CHARACTER (ASCII 12. = 0C HEX) + +-- PWB 2/13/86 + +WITH REPORT; +USE REPORT; + +PROCEDURE A22006C IS +BEGIN + TEST ("A22006C", "CHECK THAT A COMPILATION CAN BE PRECEDED " & + "BY EXTRA LINES"); + RESULT; +END A22006C; diff --git a/gcc/testsuite/ada/acats/tests/a/a22006d.ada b/gcc/testsuite/ada/acats/tests/a/a22006d.ada new file mode 100644 index 000000000..d19362c9d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a22006d.ada @@ -0,0 +1,41 @@ + -- A22006D.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A COMPILATION CAN BE PRECEDED BY SPACES AND +-- HORIZONTAL TABULATION CHARACTERS. + +-- NOTE: THE FIRST LINE OF THIS FILE BEGINS WITH FOUR SPACE +-- CHARACTERS AND A HORIZONTAL TABULATION CHARACTER + +-- PWB 2/13/86 + +WITH REPORT; +USE REPORT; + +PROCEDURE A22006D IS +BEGIN + TEST ("A22006D", "CHECK THAT A COMPILATION CAN BE PRECEDED " & + "BY SPACE AND HORIZONTAL TABULATION CHARACTERS"); + RESULT; +END A22006D; diff --git a/gcc/testsuite/ada/acats/tests/a/a26007a.tst b/gcc/testsuite/ada/acats/tests/a/a26007a.tst new file mode 100644 index 000000000..d40aa3d13 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a26007a.tst @@ -0,0 +1,48 @@ +-- A26007A.TST + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A STRING LITERAL HAVING THE MAXIMUM PERMITTED LINE LENGTH +-- CAN BE GENERATED. + +-- TBN 3/5/86 + +WITH REPORT; USE REPORT; +PROCEDURE A26007A IS + + MAX_LEN_STRING_LIT : STRING (1 .. $MAX_IN_LEN - 2); + + -- MAX_IN_LEN IS THE MAXIMUM LINE LENGTH PERMITTED. + +BEGIN + TEST ("A26007A", "CHECK THAT A STRING LITERAL HAVING THE " & + "MAXIMUM PERMITTED LINE LENGTH CAN BE GENERATED"); + + MAX_LEN_STRING_LIT := +$MAX_STRING_LITERAL +; + -- MAX_STRING_LITERAL IS A STRING LITERAL THAT IS MAXIMUM LENGTH. + -- QUOTES ARE COUNTED AS PART OF THE STRING LITERAL. + + RESULT; +END A26007A; diff --git a/gcc/testsuite/ada/acats/tests/a/a27003a.ada b/gcc/testsuite/ada/acats/tests/a/a27003a.ada new file mode 100644 index 000000000..77234e57d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a27003a.ada @@ -0,0 +1,51 @@ +-- A27003A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT IN A STRING LITERAL, CONSECUTIVE HYPHENS +-- ARE PERMITTED WITHOUT INDICATING A COMMENT, +-- AND THAT IN A COMMENT, A SINGLE DOUBLE-QUOTE IS +-- PERMITTED WITHOUT INDICATING A STRING LITERAL. + +-- PWB 03/04/86 + +WITH REPORT; USE REPORT; +PROCEDURE A27003A IS + + -- COMMENT : " IS PERMITTED HERE. + + STR1 : CONSTANT STRING := "AB--C"; + STR2 : STRING (1..10); + +BEGIN + + TEST ("A27003A", "CONSECUTIVE HYPHENS PERMITTED IN " & + "STRING LITERAL, AND QUOTE PERMITTED " & + "IN COMMENT"); + + STR2 := STR1 & "--ABC"; + -- COMMENT : " IS PERMITTED HERE. + + RESULT; + +END A27003A; diff --git a/gcc/testsuite/ada/acats/tests/a/a29003a.ada b/gcc/testsuite/ada/acats/tests/a/a29003a.ada new file mode 100644 index 000000000..e72de7959 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a29003a.ada @@ -0,0 +1,102 @@ +-- A29003A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT ALL PREDEFINED ATTRIBUTES EXCEPT DIGITS, DELTA, AND RANGE, +-- AND ALL PREDEFINED TYPE AND PACKAGE NAMES ARE NOT RESERVED WORDS. + +-- AH 8/11/86 + +WITH REPORT; USE REPORT; +PROCEDURE A29003A IS + SUBTYPE INT IS INTEGER; + +-- PREDEFINED ATTRIBUTES + + ADDRESS : INT := IDENT_INT(0); -- ATTRIBUTE + AFT : INT := IDENT_INT(0); -- ATTRIBUTE + BASE : INT := IDENT_INT(0); -- ATTRIBUTE + CALLABLE : INT := IDENT_INT(0); -- ATTRIBUTE + CONSTRAINED : INT := IDENT_INT(0); -- ATTRIBUTE + COUNT : INT := IDENT_INT(0); -- ATTRIBUTE + EMAX : INT := IDENT_INT(0); -- ATTRIBUTE + EPSILON : INT := IDENT_INT(0); -- ATTRIBUTE + FIRST : INT := IDENT_INT(0); -- ATTRIBUTE + FIRST_BIT : INT := IDENT_INT(0); -- ATTRIBUTE + FORE : INT := IDENT_INT(0); -- ATTRIBUTE + IMAGE : INT := IDENT_INT(0); -- ATTRIBUTE + LARGE : INT := IDENT_INT(0); -- ATTRIBUTE + LAST : INT := IDENT_INT(0); -- ATTRIBUTE + LAST_BIT : INT := IDENT_INT(0); -- ATTRIBUTE + LENGTH : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_EMAX : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_EMIN : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_MANTISSA : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_OVERFLOWS : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_RADIX : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_ROUNDS : INT := IDENT_INT(0); -- ATTRIBUTE + MANTISSA : INT := IDENT_INT(0); -- ATTRIBUTE + POS : INT := IDENT_INT(0); -- ATTRIBUTE + POSITION : INT := IDENT_INT(0); -- ATTRIBUTE + PRED : INT := IDENT_INT(0); -- ATTRIBUTE + SAFE_EMAX : INT := IDENT_INT(0); -- ATTRIBUTE + SAFE_LARGE : INT := IDENT_INT(0); -- ATTRIBUTE + SAFE_SMALL : INT := IDENT_INT(0); -- ATTRIBUTE + SIZE : INT := IDENT_INT(0); -- ATTRIBUTE + SMALL : INT := IDENT_INT(0); -- ATTRIBUTE + STORAGE_SIZE : INT := IDENT_INT(0); -- ATTRIBUTE + SUCC : INT := IDENT_INT(0); -- ATTRIBUTE + TERMINATED : INT := IDENT_INT(0); -- ATTRIBUTE + VAL : INT := IDENT_INT(0); -- ATTRIBUTE + VALUE : INT := IDENT_INT(0); -- ATTRIBUTE + WIDTH : INT := IDENT_INT(0); -- ATTRIBUTE + +-- PREDEFINED TYPES + + BOOLEAN : INT := IDENT_INT(0); -- TYPE + CHARACTER : INT := IDENT_INT(0); -- TYPE + DURATION : INT := IDENT_INT(0); -- TYPE + FLOAT : INT := IDENT_INT(0); -- TYPE + INTEGER : INT := IDENT_INT(0); -- TYPE + NATURAL : INT := IDENT_INT(0); -- TYPE + POSITIVE : INT := IDENT_INT(0); -- TYPE + STRING : INT := IDENT_INT(0); -- TYPE + +-- PREDEFINED PACKAGE NAMES + + ASCII : INT := IDENT_INT(0); -- PACKAGE + CALENDAR : INT := IDENT_INT(0); -- PACKAGE + DIRECT_IO : INT := IDENT_INT(0); -- PACKAGE + IO_EXCEPTIONS : INT := IDENT_INT(0); -- PACKAGE + LOW_LEVEL_IO : INT := IDENT_INT(0); -- PACKAGE + MACHINE_CODE : INT := IDENT_INT(0); -- PACKAGE + SEQUENTIAL_IO : INT := IDENT_INT(0); -- PACKAGE + SYSTEM : INT := IDENT_INT(0); -- PACKAGE + TEXT_IO : INT := IDENT_INT(0); -- PACKAGE + UNCHECKED_CONVERSION : INT := IDENT_INT(0); -- PACKAGE + UNCHECKED_DEALLOCATION : INT := IDENT_INT(0); -- PACKAGE + +BEGIN + TEST("A29003A", "NO ADDITIONAL RESERVED WORDS"); + RESULT; +END A29003A; diff --git a/gcc/testsuite/ada/acats/tests/a/a2a031a.ada b/gcc/testsuite/ada/acats/tests/a/a2a031a.ada new file mode 100644 index 000000000..f89f904e6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a2a031a.ada @@ -0,0 +1,72 @@ +-- A2A031A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT AN EXCLAMATION MARK CAN REPLACE A VERTICAL BAR WHEN THE +-- VERTICAL BAR IS USED AS A SEPARATOR. + +-- CONTEXTS ARE: +-- AS A CHOICE IN A VARIANT PART +-- IN A DISCRIMINANT CONSTRAINT +-- IN A CASE STATEMENT CHOICE +-- IN AN AGGREGATE +-- IN AN EXCEPTION HANDLER. + +-- JBG 5/25/85 + +WITH REPORT; USE REPORT; +PROCEDURE A2A031A IS + + TYPE ENUM IS (E1, E2, E3); + TYPE REC (A, B : ENUM) IS + RECORD + C : INTEGER; + CASE A IS + WHEN E1 ! E2 => -- CHOICE OF VARIANT. + D : INTEGER; + WHEN E3 => + E : FLOAT; + END CASE; + END RECORD; + + EX1, EX2, EX3 : EXCEPTION; + + VAR : REC (A!B => E2); -- DISCRIMINANT CONSTRAINT. + + EVAR : ENUM := E2; + +BEGIN + + TEST ("A2A031A", "CHECK USE OF ! AS SEPARATOR IN PLACE OF |"); + + CASE EVAR IS + WHEN E3 => NULL; + WHEN E2!E1 => NULL; -- CASE STATEMENT CHOICE. + END CASE; + + VAR := (A!B => E2, C ! D => 0); -- AGGREGATE. + + RESULT; +EXCEPTION + WHEN EX1!EX2 ! EX3 => NULL; -- EXCEPTION HANDLER. +END A2A031A; diff --git a/gcc/testsuite/ada/acats/tests/a/a33003a.ada b/gcc/testsuite/ada/acats/tests/a/a33003a.ada new file mode 100644 index 000000000..8fe513fbf --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a33003a.ada @@ -0,0 +1,49 @@ +-- A33003A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT THE FOLLOWING FORMS OF ALMOST RECURSIVE TYPES CAN BE +-- DECLARED: +-- A) A RECORD HAVING A COMPONENT OF AN ACCESS TYPE WHOSE DESIGNATED +-- TYPE IS THE RECORD TYPE; + +-- TBN 10/6/86 +-- DTN 11/12/91 DELETED SUBPARTS (B and C). + +WITH REPORT; USE REPORT; +PROCEDURE A33003A IS + + TYPE REC; + TYPE ACC_REC IS ACCESS REC; + TYPE REC IS + RECORD + A : INTEGER; + B : ACC_REC; + END RECORD; + +BEGIN + TEST ("A33003A", "CHECK THAT ALMOST RECURSIVE TYPES CAN BE " & + "DECLARED"); + + RESULT; +END A33003A; diff --git a/gcc/testsuite/ada/acats/tests/a/a34017c.ada b/gcc/testsuite/ada/acats/tests/a/a34017c.ada new file mode 100644 index 000000000..8884f46f6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a34017c.ada @@ -0,0 +1,105 @@ +-- A34017C.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT IF A DERIVED TYPE DEFINITION IS GIVEN IN THE VISIBLE PART +-- OF A PACKAGE, THE TYPE MAY BE USED AS THE PARENT TYPE IN A DERIVED +-- TYPE DEFINITION IN THE PRIVATE PART OF THE PACKAGE AND IN THE BODY. + +-- CHECK THAT IF A TYPE IS DECLARED IN THE VISIBLE PART OF A PACKAGE, +-- AND IS NOT A DERIVED TYPE OR A PRIVATE TYPE, IT MAY BE USED AS THE +-- PARENT TYPE IN A DERIVED TYPE DEFINITION IN THE VISIBLE PART, PRIVATE +-- PART, AND BODY. + + +-- DSJ 4/27/83 + + +WITH REPORT; +PROCEDURE A34017C IS + + USE REPORT; + +BEGIN + + TEST( "A34017C", "CHECK THAT A DERIVED TYPE MAY BE USED AS A " & + "PARENT TYPE IN THE PRIVATE PART AND BODY. " & + "CHECK THAT OTHER TYPES MAY BE USED AS PARENT " & + "TYPES IN VISIBLE PART ALSO"); + + DECLARE + + TYPE REC IS + RECORD + C : INTEGER; + END RECORD; + + PACKAGE PACK1 IS + + TYPE T1 IS RANGE 1 .. 10; + TYPE T2 IS NEW REC; + + TYPE T3 IS (A,B,C); + TYPE T4 IS ARRAY ( 1 .. 2 ) OF INTEGER; + TYPE T5 IS + RECORD + X : CHARACTER; + END RECORD; + TYPE T6 IS ACCESS INTEGER; + + TYPE N1 IS NEW T3; + TYPE N2 IS NEW T4; + TYPE N3 IS NEW T5; + TYPE N4 IS NEW T6; + + PRIVATE + + TYPE P1 IS NEW T1; + TYPE P2 IS NEW T2; + TYPE P3 IS NEW T3; + TYPE P4 IS NEW T4; + TYPE P5 IS NEW T5; + TYPE P6 IS NEW T6; + + END PACK1; + + PACKAGE BODY PACK1 IS + + TYPE Q1 IS NEW T1; + TYPE Q2 IS NEW T2; + TYPE Q3 IS NEW T3; + TYPE Q4 IS NEW T4; + TYPE Q5 IS NEW T5; + TYPE Q6 IS NEW T6; + + END PACK1; + + BEGIN + + NULL; + + END; + + RESULT; + +END A34017C; diff --git a/gcc/testsuite/ada/acats/tests/a/a35101b.ada b/gcc/testsuite/ada/acats/tests/a/a35101b.ada new file mode 100644 index 000000000..a8e5d122b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a35101b.ada @@ -0,0 +1,50 @@ +-- A35101B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT ONE ENUMERATION LITERAL IS PERMITTED IN AN ENUMERATION +-- TYPE DEFINITION. + +-- RJW 2/14/86 + +WITH REPORT; USE REPORT; + +PROCEDURE A35101B IS + +BEGIN + + TEST ("A35101B", "CHECK THAT ONE ENUMERATION LITERAL IS " & + "PERMITTED IN AN ENUMERATION TYPE " & + "DEFINITION" ); + DECLARE + + TYPE E1 IS (A); -- OK. + TYPE E2 IS ('1'); -- OK. + + BEGIN + NULL; + END; + + RESULT; + +END A35101B; diff --git a/gcc/testsuite/ada/acats/tests/a/a35402a.ada b/gcc/testsuite/ada/acats/tests/a/a35402a.ada new file mode 100644 index 000000000..03df4428f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a35402a.ada @@ -0,0 +1,63 @@ +-- A35402A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT THE BOUNDS OF AN INTEGER TYPE DEFINITION NEED NOT +-- HAVE THE SAME INTEGER TYPE. + +-- RJW 2/20/86 + +WITH REPORT; USE REPORT; + +PROCEDURE A35402A IS + +BEGIN + + TEST ( "A35402A", "CHECK THAT THE BOUNDS OF AN INTEGER " & + "TYPE DEFINITION NEED NOT HAVE THE SAME " & + "INTEGER TYPE" ); + + DECLARE + TYPE INT1 IS RANGE 1 .. 10; + TYPE INT2 IS RANGE 2 .. 8; + TYPE INT3 IS NEW INTEGER; + + I : CONSTANT INTEGER := 5; + I1 : CONSTANT INT1 := 5; + I2 : CONSTANT INT2 := 5; + I3 : CONSTANT INT3 := 5; + + TYPE INTRANGE1 IS RANGE I .. I1; -- OK. + + TYPE INTRANGE2 IS RANGE I1 .. I2; -- OK. + + TYPE INTRANGE3 IS RANGE I2 .. I3; -- OK. + + TYPE INTRANGE4 IS RANGE I3 .. I; -- OK. + BEGIN + NULL; + END; + + RESULT; + +END A35402A; diff --git a/gcc/testsuite/ada/acats/tests/a/a35801f.ada b/gcc/testsuite/ada/acats/tests/a/a35801f.ada new file mode 100644 index 000000000..bc50d2cb0 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a35801f.ada @@ -0,0 +1,64 @@ +-- A35801F.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT THE ATTRIBUTES FIRST AND LAST RETURN VALUES HAVING THE +-- SAME BASE TYPE AS THE PREFIX WHEN THE PREFIX IS A FLOATING POINT +-- TYPE. + +-- THIS CHECK IS PROVIDED THROUGH THE USE OF THIS TEST IN CONJUNCTION +-- WITH TEST B35801C. + +-- R.WILLIAMS 8/21/86 + +WITH REPORT; USE REPORT; +PROCEDURE A35801F IS + + TYPE REAL IS DIGITS 3 RANGE -100.0 .. 100.0; + SUBTYPE SURREAL IS REAL RANGE -50.0 .. 50.0; + + TYPE NFLT IS NEW FLOAT; + SUBTYPE UNIT IS NFLT RANGE -1.0 .. 1.0; + + SUBTYPE EMPTY IS FLOAT RANGE 1.0 .. -1.0; + + R1 : REAL := SURREAL'FIRST; -- OK. + R2 : REAL := SURREAL'LAST; -- OK. + + N1 : NFLT := UNIT'FIRST; -- OK. + N2 : NFLT := UNIT'LAST; -- OK. + + F1 : FLOAT := FLOAT'FIRST; -- OK. + F2 : FLOAT := FLOAT'LAST; -- OK. + + E1 : FLOAT := EMPTY'FIRST; -- OK. + E2 : FLOAT := EMPTY'LAST; -- OK. + +BEGIN + TEST ( "A35801F", "CHECK THAT THE ATTRIBUTES FIRST AND LAST " & + "RETURN VALUES HAVING THE SAME BASE TYPE AS " & + "THE PREFIX WHEN THE PREFIX IS A FLOATING " & + "POINT TYPE" ); + + RESULT; +END A35801F; diff --git a/gcc/testsuite/ada/acats/tests/a/a35902c.ada b/gcc/testsuite/ada/acats/tests/a/a35902c.ada new file mode 100644 index 000000000..2dd0c9b26 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a35902c.ada @@ -0,0 +1,51 @@ +-- A35902C.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A FIXED POINT TYPE WITH ONLY ONE MODEL NUMBER IS +-- ALLOWED. + +-- HISTORY: +-- RJW 02/26/86 CREATED ORIGINAL TEST. +-- DHH 10/15/87 CORRECTED RANGE ERRORS. + +WITH REPORT; USE REPORT; + +PROCEDURE A35902C IS + +BEGIN + + TEST ("A35902C", "CHECK THAT A FIXED POINT TYPE WITH ONLY ONE " & + "MODEL NUMBER IS ALLOWED" ); + DECLARE + TYPE F IS DELTA 1.0 RANGE -0.5 .. 0.5; -- OK. + F1 : F := 0.0; + + BEGIN + NULL; + END; + + RESULT; + +END A35902C; diff --git a/gcc/testsuite/ada/acats/tests/a/a38106d.ada b/gcc/testsuite/ada/acats/tests/a/a38106d.ada new file mode 100644 index 000000000..7db6aa6bb --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a38106d.ada @@ -0,0 +1,99 @@ +-- A38106D.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS AN INCOMPLETE +-- TYPE, ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON +-- CHARACTERISTICS OF THE FULL DECLARATION OF THE TYPE ARE MADE +-- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE +-- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE +-- INCOMPLETE TYPE. + +-- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES +-- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES +-- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY +-- TYPES + +-- PART 1: FULL DECLARATION OF INCOMPLETE TYPE IN PACKAGE SPECIFICATION. + +-- DSJ 5/05/83 +-- SPS 10/18/83 +-- EG 12/19/83 + +WITH REPORT ; +PROCEDURE A38106D IS + + USE REPORT ; + +BEGIN + + TEST("A38106D", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS " & + "TYPES OF INCOMPLETE TYPES ARE AVAILABLE AT THE " & + "EARLIEST PLACE IN THE IMMEDIATE SCOPE OF THE " & + "ACCESS TYPE AND AFTER THE FULL DECLARATION " & + "(WHICH IS IN THE PACKAGE SPECIFICATION)") ; + + DECLARE + + PACKAGE PACK1 IS + TYPE T1 ; + TYPE T2 ; + + PACKAGE PACK2 IS + TYPE ACC1 IS ACCESS T1 ; + TYPE ACC2 IS ACCESS T2 ; + END PACK2 ; + + TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ; + TYPE T2 IS + RECORD + C1, C2 : INTEGER ; + END RECORD ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + A1 : PACK2.ACC1 := NEW T1'(2,4) ; -- LEGAL + A2 : PACK2.ACC1 := NEW T1'(6,8) ; -- LEGAL + R1 : PACK2.ACC2 := NEW T2'(3,5) ; -- LEGAL + R2 : PACK2.ACC2 := NEW T2'(7,9) ; -- LEGAL + + PACKAGE BODY PACK2 IS + X1 : INTEGER := A1(1) ; -- LEGAL + X2 : INTEGER := A1'FIRST ; -- LEGAL + X3 : INTEGER := A1'LAST ; -- LEGAL + X4 : INTEGER := A1'LENGTH ; -- LEGAL + B1 : BOOLEAN := 3 IN A1'RANGE ; -- LEGAL + X5 : INTEGER := R1.C1 ; -- LEGAL + END PACK2 ; + + END PACK1 ; + + BEGIN + + NULL ; + + END ; + + RESULT ; + +END A38106D ; diff --git a/gcc/testsuite/ada/acats/tests/a/a38106e.ada b/gcc/testsuite/ada/acats/tests/a/a38106e.ada new file mode 100644 index 000000000..a0778acfd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a38106e.ada @@ -0,0 +1,99 @@ +-- A38106E.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS AN INCOMPLETE +-- TYPE, ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON +-- CHARACTERISTICS OF THE FULL DECLARATION OF THE TYPE ARE MADE +-- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE +-- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE +-- INCOMPLETE TYPE. + +-- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES +-- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES +-- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY +-- TYPES + +-- PART 2 : FULL DECLARATION OF INCOMPLETE TYPE IN PACKAGE BODY + +-- DSJ 5/05/83 +-- SPS 10/18/83 +-- EG 12/19/83 + +WITH REPORT ; +PROCEDURE A38106E IS + + USE REPORT ; + +BEGIN + + TEST("A38106E", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS " & + "TYPES OF INCOMPLETE TYPES ARE AVAILABLE AT THE " & + "EARLIEST PLACE IN THE IMMEDIATE SCOPE OF THE " & + "ACCESS TYPE AND AFTER THE FULL DECLARATION " & + "(WHICH IS IN THE PACKAGE BODY)"); + + DECLARE + + PACKAGE PACK1 IS + PRIVATE + TYPE T1 ; + TYPE T2 ; + PACKAGE PACK2 IS + TYPE ACC1 IS ACCESS T1 ; + TYPE ACC2 IS ACCESS T2 ; + END PACK2 ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ; + TYPE T2 IS + RECORD + C1, C2 : INTEGER ; + END RECORD ; + + A1 : PACK2.ACC1 := NEW T1'(2,4) ; -- LEGAL + A2 : PACK2.ACC1 := NEW T1'(6,8) ; -- LEGAL + R1 : PACK2.ACC2 := NEW T2'(3,5) ; -- LEGAL + R2 : PACK2.ACC2 := NEW T2'(7,9) ; -- LEGAL + + PACKAGE BODY PACK2 IS + X1 : INTEGER := A1(1) ; -- LEGAL + X2 : INTEGER := A1'FIRST ; -- LEGAL + X3 : INTEGER := A1'LAST ; -- LEGAL + X4 : INTEGER := A1'LENGTH ; -- LEGAL + B1 : BOOLEAN := 3 IN A1'RANGE ; -- LEGAL + X5 : INTEGER := R1.C1 ; -- LEGAL + END PACK2 ; + + END PACK1 ; + + BEGIN + + NULL ; + + END ; + + RESULT ; + +END A38106E ; diff --git a/gcc/testsuite/ada/acats/tests/a/a49027a.ada b/gcc/testsuite/ada/acats/tests/a/a49027a.ada new file mode 100644 index 000000000..83e531b5e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a49027a.ada @@ -0,0 +1,85 @@ +-- A49027A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A SUBTYPE CAN BE NONSTATIC IN A GENERIC TEMPLATE AND +-- STATIC IN THE CORRESPONDING INSTANCE. +-- CHECK THAT FOR A GENERIC INSTANTIATION, IF THE ACTUAL PARAMETER +-- IS A STATIC SUBTYPE, THEN EVERY USE OF THE CORRESPONDING FORMAL +-- PARAMETER WITHIN THE INSTANCE IS CONSIDERED TO DENOTE A STATIC +-- SUBTYPE +-- +-- THIS IS A TEST BASED ON AI-00409/05-BI-WJ. + +-- HISTORY: +-- EDWARD V. BERARD, 27 AUGUST 1990 +-- CJJ 10 OCT 1990 TEST OBJECTIVE CHANGED TO REFLECT AIG +-- OBJECTIVE. + +WITH REPORT ; + +PROCEDURE A49027A IS + +BEGIN -- A49027A + + REPORT.TEST ("A49027A", "CHECK THAT A SUBTYPE CAN BE NONSTATIC " & + "IN A GENERIC TEMPLATE AND STATIC IN THE " & + "CORRESPONDING INSTANCE.") ; + + LOCAL_BLOCK: + + DECLARE + + TYPE NUMBER IS RANGE 1 .. 10 ; + + GENERIC + + TYPE NUMBER_TYPE IS RANGE <> ; + + PACKAGE STATIC_TEST IS + + TYPE NEW_NUMBER_TYPE IS NEW NUMBER_TYPE ; + SUBTYPE SUB_NUMBER_TYPE IS NUMBER_TYPE ; + + END STATIC_TEST ; + + PACKAGE NEW_STATIC_TEST IS NEW STATIC_TEST + (NUMBER_TYPE => NUMBER) ; + + TYPE ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.NEW_NUMBER_TYPE'FIRST .. + NEW_STATIC_TEST.NEW_NUMBER_TYPE'LAST ; + + TYPE YET_ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.SUB_NUMBER_TYPE'FIRST .. + NEW_STATIC_TEST.SUB_NUMBER_TYPE'LAST ; + + BEGIN -- LOCAL_BLOCK + + NULL ; + + END LOCAL_BLOCK ; + + REPORT.RESULT ; + +END A49027A ; diff --git a/gcc/testsuite/ada/acats/tests/a/a49027b.ada b/gcc/testsuite/ada/acats/tests/a/a49027b.ada new file mode 100644 index 000000000..a27956d74 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a49027b.ada @@ -0,0 +1,159 @@ +-- A49027B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A SUBTYPE CAN BE NONSTATIC IN A GENERIC TEMPLATE +-- AND STATIC IN THE CORRESPONDING INSTANCE. + +-- CHECK THAT IF A GENERIC PARAMETER IS A STATIC EXPRESSION AND THE +-- CORRESPONDING (IN) PARAMETER HAS A STATIC SUBTYPE IN THE INSTANCE, +-- THEN EACH USE OF THE FORMAL PARAMETERS IN THE INSTANCE IS SAID TO +-- BE STATIC. +-- +-- A NAME DENOTING A CONSTANT DECLARED IN A GENERIC INSTANCE IS +-- ALLOWED AS A PRIMARY IN A STATIC EXPRESSION IF THE CONSTANT +-- IS DECLARED BY A CONSTANT DECLARATION WITH A STATIC SUBTYPE +-- AND INITIALIZED WITH A STATIC EXPRESSION. +-- +-- THIS IS A TEST BASED ON AI-00505/03-BI-WA. + +-- HISTORY: +-- EDWARD V. BERARD, 27 AUGUST 1990 +-- DAS 8 OCT 90 ADDED CODE TO MATCH EXAMPLE 1 IN +-- AI-00505. +-- JRL 05/29/92 CORRECTED MINOR PROBLEM IN REPORT.TEST STRING. +-- JRL 02/18/93 EXPANDED TEXT OF REPORT.TEST STRING. +-- PWN 04/14/95 CORRECTED MINOR COPYRIGHT COMMENT PROBLEM. + + +WITH REPORT ; + +PROCEDURE A49027B IS + +BEGIN -- A49027B + + REPORT.TEST ("A49027B", "CHECK THAT IF A GENERIC ACTUAL " & + "PARAMETER IS A STATIC EXPRESSION AND THE " & + "CORRESPONDING FORMAL PARAMETER HAS A STATIC " & + "SUBTYPE IN THE INSTANCE, THEN EACH USE OF THE " & + "FORMAL PARAMETER IN THE INSTANCE IS SAID TO BE " & + "STATIC. CHECK THAT A NAME DENOTING A CONSTANT " & + "DECLARED IN A GENERIC INSTANCE IS ALLOWED AS " & + "A PRIMARY IN A STATIC EXPRESSION IF THE " & + "CONSTANT IS DECLARED BY A CONSTANT DECLARATION " & + "WITH A STATIC SUBTYPE AND INITIALIZED WITH A " & + "STATIC EXPRESSION. (AI-00505)"); + + LOCAL_BLOCK: + + DECLARE + + TYPE NUMBER IS RANGE 1 .. 10 ; + TYPE COLOR IS (RED, ORANGE, YELLOW, GREEN, BLUE) ; + MIDDLE_COLOR : CONSTANT COLOR := GREEN ; + + ENUMERATED_VALUE : COLOR := COLOR'LAST ; + + GENERIC + + TYPE NUMBER_TYPE IS RANGE <> ; + X : INTEGER ; + TYPE ENUMERATED IS (<>) ; + + FIRST_NUMBER : IN NUMBER_TYPE ; + SECOND_NUMBER : IN NUMBER_TYPE ; + THIRD_NUMBER : IN NUMBER_TYPE ; + FIRST_ENUMERATED : IN ENUMERATED ; + SECOND_ENUMERATED : IN ENUMERATED ; + THIRD_ENUMERATED : IN ENUMERATED ; + + FIRST_INTEGER_VALUE : IN INTEGER ; + SECOND_INTEGER_VALUE : IN INTEGER ; + + PACKAGE STATIC_TEST IS + + Y : CONSTANT INTEGER := X; + Z : CONSTANT NUMBER_TYPE := 5; + + SUBTYPE FIRST_NUMBER_SUBTYPE IS NUMBER_TYPE + RANGE FIRST_NUMBER .. SECOND_NUMBER ; + SUBTYPE SECOND_NUMBER_SUBTYPE IS NUMBER_TYPE + RANGE FIRST_NUMBER .. THIRD_NUMBER ; + + SUBTYPE FIRST_ENUMERATED_SUBTYPE IS ENUMERATED + RANGE FIRST_ENUMERATED .. SECOND_ENUMERATED ; + SUBTYPE SECOND_ENUMERATED_SUBTYPE IS ENUMERATED + RANGE FIRST_ENUMERATED .. THIRD_ENUMERATED ; + + SUBTYPE THIRD_NUMBER_TYPE IS INTEGER + RANGE FIRST_INTEGER_VALUE .. SECOND_INTEGER_VALUE ; + + END STATIC_TEST ; + + PACKAGE NEW_STATIC_TEST IS NEW STATIC_TEST + (NUMBER_TYPE => NUMBER, + X => 3, + ENUMERATED => COLOR, + FIRST_NUMBER => NUMBER'FIRST, + SECOND_NUMBER => NUMBER'LAST, + THIRD_NUMBER => NUMBER'SUCC(NUMBER'FIRST), + FIRST_ENUMERATED => RED, + SECOND_ENUMERATED => MIDDLE_COLOR, + THIRD_ENUMERATED => COLOR'VAL (1), + FIRST_INTEGER_VALUE => COLOR'POS (YELLOW), + SECOND_INTEGER_VALUE => NUMBER'POS (5)) ; + + TYPE T1 IS RANGE 1 .. NEW_STATIC_TEST.Y; + TYPE T2 IS RANGE 1 .. NEW_STATIC_TEST.Z; + + TYPE ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.FIRST_NUMBER_SUBTYPE'FIRST .. + NEW_STATIC_TEST.FIRST_NUMBER_SUBTYPE'LAST ; + + TYPE YET_ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.SECOND_NUMBER_SUBTYPE'FIRST .. + NEW_STATIC_TEST.SECOND_NUMBER_SUBTYPE'LAST ; + + TYPE STILL_ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.THIRD_NUMBER_TYPE'FIRST .. + NEW_STATIC_TEST.THIRD_NUMBER_TYPE'LAST ; + + BEGIN -- LOCAL_BLOCK + + CASE ENUMERATED_VALUE IS + WHEN YELLOW => NULL ; + WHEN NEW_STATIC_TEST.FIRST_ENUMERATED_SUBTYPE'FIRST + => NULL ; + WHEN NEW_STATIC_TEST.FIRST_ENUMERATED_SUBTYPE'LAST + => NULL ; + WHEN NEW_STATIC_TEST.SECOND_ENUMERATED_SUBTYPE'LAST + => NULL ; + WHEN COLOR'LAST => NULL ; + END CASE ; + + END LOCAL_BLOCK ; + + REPORT.RESULT ; + +END A49027B ; diff --git a/gcc/testsuite/ada/acats/tests/a/a49027c.ada b/gcc/testsuite/ada/acats/tests/a/a49027c.ada new file mode 100644 index 000000000..a10449e91 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a49027c.ada @@ -0,0 +1,70 @@ +-- A49027C.ADA +-- +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- +-- OBJECTIVE: +-- CHECK THAT IF A GENERIC PARAMETER IS A STATIC EXPRESSION AND THE +-- CORRESPONDING (IN) PARAMETER HAS A STATIC SUBTYPE IN THE INSTANCE, +-- THEN EACH USE OF THE FORMAL PARAMETER IN THE INSTANCE IS SAID TO +-- BE STATIC. +-- +-- SEE AI-00505. THIS TEST IS TAKEN FROM THE SECOND EXAMPLE. +-- +-- HISTORY: +-- DAS 8 OCT 90 INITIAL VERSION. +-- PWN 12/01/95 CORRECTED FORMAT OF CALL TO REPORT.TEST +-- KAS 25NOV96 CHANGED LITERAL 7 TO (IMPDEF.CHAR_BITS-1) +--! + +WITH REPORT; USE REPORT; +WITH IMPDEF; + +PROCEDURE A49027C IS + + GENERIC + X : INTEGER; + PACKAGE GP IS + TYPE REC IS + RECORD + C : STRING (1..X); + END RECORD; + END GP; + + PACKAGE NP IS NEW GP (1); + + TYPE NR IS NEW NP.REC; + FOR NR USE + RECORD + C AT 0 RANGE 0..IMPDEF.CHAR_BITS-1; -- SUBTYPE INDICATION + END RECORD; -- FOR C IN NP IS CONSIDERED STATIC. + +BEGIN + TEST("A49027C", "CHECK THAT IF A GENERIC PARAMETER IS A STATIC " & + "EXPRESSION AND THE CORRESPONDING (IN) PARAMETER HAS A " & + "STATIC SUBTYPE IN THE INSTANCE, THEN EACH USE OF THE " & + "FORMAL PARAMETER IN THE INSTANCE IS SAID TO BE STATIC."); + + RESULT; + +END A49027C; diff --git a/gcc/testsuite/ada/acats/tests/a/a54b01a.ada b/gcc/testsuite/ada/acats/tests/a/a54b01a.ada new file mode 100644 index 000000000..6a7b1ac24 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a54b01a.ada @@ -0,0 +1,119 @@ +-- A54B01A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT IF A CASE EXPRESSION IS A CONSTANT, VARIABLE, +-- TYPE CONVERSION, OR QUALIFIED EXPRESSION, +-- AND THE SUBTYPE OF THE +-- EXPRESSION IS STATIC, AN 'OTHERS' CAN BE OMITTED IF ALL +-- VALUES IN THE SUBTYPE'S RANGE ARE COVERED. + + +-- RM 01/23/80 +-- SPS 10/26/82 +-- SPS 2/1/83 + +WITH REPORT ; +PROCEDURE A54B01A IS + + USE REPORT ; + +BEGIN + + TEST("A54B01A" , "CHECK THAT IF" & + " THE SUBTYPE OF A CASE EXPRESSION IS STATIC," & + " AN 'OTHERS' CAN BE OMITTED IF ALL" & + " VALUES IN THE SUBTYPE'S RANGE ARE COVERED" ); + + -- THE TEST CASES APPEAR IN THE FOLLOWING ORDER: + -- + -- I. CONSTANTS + -- + -- II. STATIC SUBRANGES + -- + -- (A) VARIABLES (INTEGER , BOOLEAN) + -- (B) QUALIFIED EXPRESSIONS + -- (C) TYPE CONVERSIONS + + DECLARE -- CONSTANTS + T : CONSTANT BOOLEAN := TRUE; + FIVE : CONSTANT INTEGER := IDENT_INT(5); + BEGIN + + CASE FIVE IS + WHEN INTEGER'FIRST..4 => NULL ; + WHEN 5 => NULL ; + WHEN 6 .. INTEGER'LAST => NULL ; + END CASE; + + CASE T IS + WHEN TRUE => NULL ; + WHEN FALSE => NULL ; + END CASE; + + END ; + + + DECLARE -- STATIC SUBRANGES + + SUBTYPE STAT IS INTEGER RANGE 1..5 ; + I : INTEGER RANGE 1..5 ; + J : STAT ; + BOOL: BOOLEAN := FALSE ; + CHAR: CHARACTER := 'U' ; + TYPE ENUMERATION IS ( FIRST,SECOND,THIRD,FOURTH,FIFTH ); + ENUM: ENUMERATION := THIRD ; + + + BEGIN + + I := IDENT_INT( 2 ); + J := IDENT_INT( 2 ); + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + CASE BOOL IS + WHEN TRUE => NULL ; + WHEN FALSE => NULL ; + END CASE; + + CASE STAT'( 2 ) IS + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + END CASE; + + CASE STAT( J ) IS + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + END CASE; + + + END ; -- STATIC SUBRANGES + + RESULT ; + + +END A54B01A ; diff --git a/gcc/testsuite/ada/acats/tests/a/a54b02a.ada b/gcc/testsuite/ada/acats/tests/a/a54b02a.ada new file mode 100644 index 000000000..08d908ee9 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a54b02a.ada @@ -0,0 +1,184 @@ +-- A54B02A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT IF A CASE EXPRESSION IS A VARIABLE, CONSTANT, TYPE +-- CONVERSION, ATTRIBUTE (IN PARTICULAR 'FIRST AND 'LAST), +-- FUNCTION INVOCATION, QUALIFIED EXPRESSION, OR A PARENTHESIZED +-- EXPRESSION HAVING ONE OF THESE FORMS, AND THE SUBTYPE OF THE +-- EXPRESSION IS NON-STATIC, AN 'OTHERS' CAN BE OMITTED IF ALL +-- VALUES IN THE BASE TYPE'S RANGE ARE COVERED. + +-- RM 01/27/80 +-- SPS 10/26/82 +-- SPS 2/2/83 +-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X. + +WITH REPORT ; +PROCEDURE A54B02A IS + + USE REPORT ; + +BEGIN + + TEST("A54B02A" , "CHECK THAT IF THE" & + " SUBTYPE OF A CASE EXPRESSION IS NON-STATIC," & + " AN 'OTHERS' CAN BE OMITTED IF ALL" & + " VALUES IN THE BASE TYPE'S RANGE ARE COVERED" ); + + -- THE TEST CASES APPEAR IN THE FOLLOWING ORDER: + -- + -- (A) VARIABLES (INTEGER , BOOLEAN) + -- (B) CONSTANTS (INTEGER, BOOLEAN) + -- (C) ATTRIBUTES ('FIRST, 'LAST) + -- (D) FUNCTION CALLS + -- (E) QUALIFIED EXPRESSIONS + -- (F) TYPE CONVERSIONS + -- (G) PARENTHESIZED EXPRESSIONS OF THE ABOVE KINDS + + + DECLARE -- NON-STATIC RANGES + + SUBTYPE STAT IS INTEGER RANGE 1..50 ; + SUBTYPE DYN IS STAT RANGE 1..IDENT_INT( 5 ) ; + I : STAT RANGE 1..IDENT_INT( 5 ); + J : DYN ; + SUBTYPE DYNCHAR IS + CHARACTER RANGE ASCII.NUL .. IDENT_CHAR('Q'); + SUBTYPE STATCHAR IS + DYNCHAR RANGE 'A' .. 'C' ; + CHAR: DYNCHAR := 'F' ; + TYPE ENUMERATION IS ( A,B,C,D,E,F,G,H,K,L,M,N ); + SUBTYPE STATENUM IS + ENUMERATION RANGE A .. L ; + SUBTYPE DYNENUM IS + STATENUM RANGE A .. ENUMERATION'VAL(IDENT_INT(5)); + ENUM: DYNENUM := B ; + CONS : CONSTANT DYN := 3; + + FUNCTION FF RETURN DYN IS + BEGIN + RETURN 2 ; + END FF ; + + BEGIN + + I := IDENT_INT( 2 ); + J := IDENT_INT( 2 ); + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE J IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE CONS IS + WHEN INTEGER'FIRST..INTEGER'LAST => NULL; + END CASE; + + CASE DYN'FIRST IS + WHEN INTEGER'FIRST..0 => NULL; + WHEN 1..INTEGER'LAST => NULL; + END CASE; + + CASE STATCHAR'LAST IS + WHEN CHARACTER'FIRST..'A' => NULL; + WHEN 'B'..CHARACTER'LAST => NULL; + END CASE; + + CASE FF IS + WHEN 4..5 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + WHEN 1..3 => NULL ; + END CASE; + + CASE DYN'( 2 ) IS + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + END CASE; + + CASE DYN( J ) IS + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + + CASE ( CHAR ) IS + WHEN ASCII.NUL .. 'P' => NULL ; + WHEN 'Q' => NULL ; + WHEN 'R' .. 'Y' => NULL ; + WHEN 'Z' .. CHARACTER'LAST => NULL ; + END CASE; + + CASE ( ENUM ) IS + WHEN A | C | E => NULL ; + WHEN B | D => NULL ; + WHEN F .. L => NULL ; + WHEN M .. N => NULL ; + END CASE; + + CASE ( FF ) IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE ( DYN'( I ) ) IS + WHEN 4..5 => NULL ; + WHEN 1..3 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE ( DYN( 2 ) ) IS + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE (CONS) IS + WHEN 1..100 => NULL; + WHEN INTEGER'FIRST..0 => NULL; + WHEN 101..INTEGER'LAST => NULL; + END CASE; + + CASE (DYNCHAR'LAST) IS + WHEN 'B'..'Y' => NULL; + WHEN CHARACTER'FIRST..'A' => NULL; + WHEN 'Z'..CHARACTER'LAST => NULL; + END CASE; + + END; + + + RESULT ; + + +END A54B02A ; diff --git a/gcc/testsuite/ada/acats/tests/a/a55b12a.ada b/gcc/testsuite/ada/acats/tests/a/a55b12a.ada new file mode 100644 index 000000000..75458075b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a55b12a.ada @@ -0,0 +1,147 @@ +-- A55B12A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT THE SUBTYPE OF A LOOP PARAMETER IN A LOOP OF THE FORM +-- +-- FOR I IN ST RANGE L..R LOOP +-- +-- IS CORRECTLY DETERMINED SO THAT WHEN THE LOOP PARAMETER IS USED +-- IN A CASE STATEMENT AN 'OTHERS' ALTERNATIVE IS NOT REQUIRED IF +-- THE CHOICES COVER THE APPROPRIATE RANGE OF SUBTYPE VALUES. + +-- CASE A : +-- L AND R ARE BOTH STATIC EXPRESSIONS, AND ST IS A STATIC +-- SUBTYPE COVERING A RANGE GREATER THAN L..R . + + +-- RM 02/02/80 +-- JRK 03/02/83 + +WITH REPORT ; +PROCEDURE A55B12A IS + + USE REPORT ; + +BEGIN + + TEST("A55B12A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER" & + " IN A LOOP OF THE FORM 'FOR I IN ST RANGE" & + " L..R LOOP' IS CORRECTLY DETERMINED (A)" ); + + DECLARE + + SUBTYPE STAT IS INTEGER RANGE 1..10 ; + TYPE NEW_STAT IS NEW INTEGER RANGE 1..10 ; + + TYPE ENUMERATION IS ( A,B,C,D,E,F,G,H,K,L,M,N ); + SUBTYPE STAT_E IS ENUMERATION RANGE A..L ; + SUBTYPE STAT_B IS BOOLEAN RANGE FALSE..TRUE ; + SUBTYPE STAT_C IS CHARACTER RANGE 'A'..'L' ; + + BEGIN + + FOR I IN STAT RANGE 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + FOR I IN NEW_STAT RANGE 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + FOR I IN INTEGER RANGE 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + + FOR I IN REVERSE STAT RANGE 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + + FOR I IN STAT_E RANGE A..E LOOP + + CASE I IS + WHEN C..E => NULL ; + WHEN A..B => NULL ; + END CASE; + + END LOOP; + + + FOR I IN STAT_B RANGE TRUE..TRUE LOOP + + CASE I IS + WHEN TRUE => NULL ; + END CASE; + + END LOOP; + + + FOR I IN STAT_C RANGE 'A'..'E' LOOP + + CASE I IS + WHEN 'A'..'C' => NULL ; + WHEN 'D'..'E' => NULL ; + END CASE; + + END LOOP; + + + FOR I IN STAT_C RANGE 'E'..'B' LOOP + + CASE I IS + WHEN 'D'..'C' => NULL ; + WHEN 'E'..'B' => NULL ; + WHEN 'F'..'A' => NULL ; + WHEN 'M'..'A' => NULL ; + END CASE; + + END LOOP; + + + END ; + + RESULT ; + +END A55B12A ; diff --git a/gcc/testsuite/ada/acats/tests/a/a55b13a.ada b/gcc/testsuite/ada/acats/tests/a/a55b13a.ada new file mode 100644 index 000000000..c2cc5acfd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a55b13a.ada @@ -0,0 +1,128 @@ +-- A55B13A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- USING A CASE_STATEMENT , CHECK THAT IF L , R ARE LITERALS +-- OF TYPE T (INTEGER, BOOLEAN, CHARACTER, USER-DEFINED +-- ENUMERATION TYPE) THE SUBTYPE BOUNDS ASSOCIATED WITH A +-- LOOP OF THE FORM +-- FOR I IN L..R LOOP +-- ARE THE SAME AS THOSE FOR THE CORRESPONDING LOOP OF THE FORM +-- FOR I IN T RANGE L..R LOOP . + + +-- RM 04/07/81 +-- SPS 3/2/83 +-- JBG 8/21/83 +-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X. + +WITH REPORT ; +PROCEDURE A55B13A IS + + USE REPORT ; + +BEGIN + + TEST("A55B13A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER" & + " IN A LOOP OF THE FORM 'FOR I IN " & + " LITERAL_L .. LITERAL_R LOOP' IS CORRECTLY" & + " DETERMINED" ); + + DECLARE + + TYPE ENUMERATION IS ( A,B,C,D,MIDPOINT,E,F,G,H ); + ONE : CONSTANT := 1 ; + FIVE : CONSTANT := 5 ; + + + BEGIN + + + FOR I IN 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + + FOR I IN REVERSE ONE .. FIVE LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + + FOR I IN REVERSE FALSE..TRUE LOOP + + CASE I IS + WHEN FALSE => NULL ; + WHEN TRUE => NULL ; + END CASE; + + END LOOP; + + + FOR I IN CHARACTER'('A') .. ASCII.DEL LOOP + + CASE I IS + WHEN CHARACTER'('A')..CHARACTER'('U') => NULL ; + WHEN CHARACTER'('V')..ASCII.DEL => NULL ; + END CASE; + + END LOOP; + + + FOR I IN CHARACTER'('A')..CHARACTER'('H') LOOP + + CASE I IS + WHEN CHARACTER'('A')..CHARACTER'('D') => NULL ; + WHEN CHARACTER'('E')..CHARACTER'('H') => NULL ; + END CASE; + + END LOOP; + + + FOR I IN REVERSE B..H LOOP + + CASE I IS + WHEN B..D => NULL ; + WHEN E..H => NULL ; + WHEN MIDPOINT => NULL ; + END CASE; + + END LOOP; + + + END ; + + + RESULT ; + + +END A55B13A ; diff --git a/gcc/testsuite/ada/acats/tests/a/a55b14a.ada b/gcc/testsuite/ada/acats/tests/a/a55b14a.ada new file mode 100644 index 000000000..617d95b68 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a55b14a.ada @@ -0,0 +1,112 @@ +-- A55B14A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- USING A CASE_STATEMENT , CHECK THAT THE SUBTYPE BOUNDS ASSOCIATED +-- WITH A LOOP OF THE FORM +-- FOR I IN ST LOOP +-- ARE, RESPECTIVELY, ST'FIRST..ST'LAST WHEN ST IS STATIC. + +-- RM 04/07/81 +-- SPS 3/2/83 +-- JBG 3/14/83 + +WITH REPORT; +PROCEDURE A55B14A IS + + USE REPORT; + USE ASCII ; + + TYPE ENUMERATION IS ( A,B,C,D,MIDPOINT,E,F,G,H ); + SUBTYPE ST_I IS INTEGER RANGE 1..5 ; + TYPE NEW_ST_I IS NEW INTEGER RANGE 1..5 ; + SUBTYPE ST_E IS ENUMERATION RANGE B..G ; + SUBTYPE ST_B IS BOOLEAN RANGE FALSE..FALSE; + SUBTYPE ST_C IS CHARACTER RANGE 'A'..DEL ; + +BEGIN + + TEST("A55B14A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER" & + " IN A LOOP OF THE FORM 'FOR I IN ST LOOP'" & + " ARE CORRECTLY DETERMINED WHEN ST IS STATIC" ); + + BEGIN + + + FOR I IN ST_I LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL; + WHEN 2 | 4 => NULL; + END CASE; + + END LOOP; + + + FOR I IN NEW_ST_I LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL; + WHEN 2 | 4 => NULL; + END CASE; + + END LOOP; + + + FOR I IN ST_B LOOP + + CASE I IS + WHEN FALSE => NULL; + END CASE; + + END LOOP; + + + FOR I IN ST_C LOOP + + CASE I IS + WHEN 'A'..'U' => NULL; + WHEN 'V'..DEL => NULL; + END CASE; + + END LOOP; + + + FOR I IN ST_E LOOP + + CASE I IS + WHEN B..D => NULL; + WHEN E..G => NULL; + WHEN MIDPOINT => NULL; + END CASE; + + END LOOP; + + + END; + + + RESULT; + + +END A55B14A; diff --git a/gcc/testsuite/ada/acats/tests/a/a71004a.ada b/gcc/testsuite/ada/acats/tests/a/a71004a.ada new file mode 100644 index 000000000..da793a8b3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a71004a.ada @@ -0,0 +1,130 @@ +-- A71004A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT ALL FORMS OF DECLARATION PERMITTED IN THE PRIVATE PART OF +-- A PACKAGE ARE INDEED ACCEPTED BY THE COMPILER. +-- TASKS, GENERICS, FIXED AND FLOAT DECLARATIONS ARE NOT TESTED. + +-- DAT 5/6/81 +-- VKG 2/16/83 + +WITH REPORT; USE REPORT; + +PROCEDURE A71004A IS +BEGIN + + TEST ("A71004A", "ALL FORMS OF DECLARATIONS IN PRIVATE PART"); + + DD: + DECLARE + + PACKAGE P1 IS + + TYPE P IS PRIVATE; + TYPE L IS LIMITED PRIVATE; + CP : CONSTANT P; + CL : CONSTANT L; + + PRIVATE + + ONE : CONSTANT := 1; + TWO : CONSTANT := ONE * 1.0 + 1.0; + N1, N2, N3 : CONSTANT := TWO; + TYPE I IS RANGE -10 .. 10; + X4, X5 : CONSTANT I := I(IDENT_INT(3)); + X6, X7 : I := X4 + X5; + TYPE AR IS ARRAY (I) OF L; + + X10 : ARRAY (IDENT_INT(1) .. IDENT_INT (10)) OF I; + X11 : CONSTANT ARRAY (1..10) OF I := (1..10=>3); + TYPE T3 IS (E12); + TYPE T4 IS NEW T3; + + TYPE REC1 (D:BOOLEAN:=TRUE) IS RECORD NULL; END RECORD; + SUBTYPE REC1TRUE IS REC1( D => TRUE ) ; + TYPE L IS NEW REC1TRUE ; + X8 , X9 : AR; + TYPE A6 IS ACCESS REC1 ; + SUBTYPE L1 IS L ; + SUBTYPE A7 IS A6(D=>TRUE); + SUBTYPE I14 IS I RANGE 1 .. 1; + TYPE UA1 IS ARRAY (I14 RANGE <> ) OF I14; + TYPE UA2 IS NEW UA1; + USE STANDARD.ASCII; + + PROCEDURE P1 ; + + FUNCTION F1 (X : UA1) RETURN UA1; + + FUNCTION "+" (X : UA1) RETURN UA1; + + PACKAGE PK IS + PRIVATE + END; + + PACKAGE PK1 IS + PACKAGE PK2 IS END; + PRIVATE + PACKAGE PK3 IS PRIVATE END; + END PK1; + + EX : EXCEPTION; + EX1, EX2 : EXCEPTION; + X99 : I RENAMES X7; + EX3 : EXCEPTION RENAMES EX1; + PACKAGE PQ1 RENAMES DD.P1; + PACKAGE PQ2 RENAMES PK1; + PACKAGE PQ3 RENAMES PQ2 . PK2; + FUNCTION "-" (X : UA1) RETURN UA1 RENAMES "+"; + PROCEDURE P98 RENAMES P1; + TYPE P IS NEW L; + CP : CONSTANT P := (D=> TRUE); + CL : CONSTANT L := L(CP); + + END P1; + + PACKAGE BODY P1 IS + + PROCEDURE P1 IS BEGIN NULL; END P1; + + FUNCTION F1 (X : UA1) RETURN UA1 IS + BEGIN RETURN X; END F1; + + FUNCTION "+" (X : UA1) RETURN UA1 IS + BEGIN RETURN F1(X); END "+"; + + PACKAGE BODY PK1 IS + PACKAGE BODY PK3 IS END; + END PK1; + + BEGIN + NULL ; + END P1; + + BEGIN + NULL; + END DD; + RESULT; + +END A71004A; diff --git a/gcc/testsuite/ada/acats/tests/a/a73001i.ada b/gcc/testsuite/ada/acats/tests/a/a73001i.ada new file mode 100644 index 000000000..9595d0086 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a73001i.ada @@ -0,0 +1,73 @@ +-- A73001I.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT IF A SUBPROGRAM IS DECLARED BY A RENAMING DECLARATION OR +-- GENERIC INSTANTIATION IN A PACKAGE SPECIFICATION NO PACKAGE BODY IS +-- REQUIRED. + +-- BHS 6/26/84 + +WITH REPORT; +PROCEDURE A73001I IS + + USE REPORT; + +BEGIN + + TEST ("A73001I", "CHECK THAT NO PACKAGE BODY IS REQUIRED FOR " & + "SUBPROGRAM DECLARED BY RENAMING DECLARATION " & + "OR GENERIC INSTANTIATION IN A PACKAGE " & + "SPECIFICATION"); + + DECLARE + PACKAGE PACK1 IS + FUNCTION ADDI (X,Y : INTEGER) RETURN INTEGER RENAMES "+"; + END PACK1; + + BEGIN + NULL; + END; + + + DECLARE + GENERIC + TYPE ITEM IS RANGE <>; + PROCEDURE P (X : IN OUT ITEM); + + PROCEDURE P (X : IN OUT ITEM) IS + BEGIN + NULL; + END P; + + PACKAGE PACK2 IS + PROCEDURE NADA IS NEW P (INTEGER); + END PACK2; + + BEGIN + NULL; + END; + + RESULT; + +END A73001I; diff --git a/gcc/testsuite/ada/acats/tests/a/a73001j.ada b/gcc/testsuite/ada/acats/tests/a/a73001j.ada new file mode 100644 index 000000000..025e6db03 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a73001j.ada @@ -0,0 +1,78 @@ +-- A73001J.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT IF A SUBPROGRAM IS DECLARED BY A RENAMING DECLARATION OR +-- GENERIC INSTANTIATION IN A GENERIC PACKAGE SPECIFICATION, NO PACKAGE +-- BODY IS REQUIRED. + + +-- BHS 6/27/84 + +WITH REPORT; +PROCEDURE A73001J IS + + USE REPORT; + +BEGIN + + TEST ("A73001J", "CHECK THAT NO PACKAGE BODY IS REQUIRED FOR " & + "SUBPROGRAM DECLARED BY RENAMING DECLARATION " & + "OR GENERIC INSTANTIATION IN A GENERIC " & + "PACKAGE SPECIFICATION"); + + DECLARE + GENERIC + TYPE ITEM IS RANGE <>; + PACKAGE PACK1 IS + FUNCTION ADDI (X,Y : ITEM) RETURN ITEM RENAMES "+"; + END PACK1; + + BEGIN + NULL; + END; + + + DECLARE + GENERIC + TYPE ITEM IS RANGE <>; + PROCEDURE P (X : IN OUT ITEM); + + PROCEDURE P (X : IN OUT ITEM) IS + BEGIN + NULL; + END P; + + GENERIC + TYPE OBJ IS RANGE <>; + PACKAGE PACK2 IS + PROCEDURE NADA IS NEW P (OBJ); + END PACK2; + + BEGIN + NULL; + END; + + RESULT; + +END A73001J; diff --git a/gcc/testsuite/ada/acats/tests/a/a74105b.ada b/gcc/testsuite/ada/acats/tests/a/a74105b.ada new file mode 100644 index 000000000..2bd4e09b4 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a74105b.ada @@ -0,0 +1,78 @@ +-- A74105B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT THE FULL TYPE DECLARATION OF A PRIVATE TYPE WITHOUT +-- DISCRIMINANTS MAY BE A CONSTRAINED TYPE WITH DISCRIMINANTS. + +-- DSJ 4/29/83 +-- SPS 10/22/83 + +WITH REPORT; +PROCEDURE A74105B IS + + USE REPORT; + +BEGIN + + TEST ("A74105B", "CHECK THAT THE FULL TYPE DECLARATION OF A " & + "PRIVATE TYPE WITHOUT DISCRIMINANTS MAY BE " & + "A CONSTRAINED TYPE WITH DISCRIMINANTS"); + + DECLARE + + TYPE REC1 (D : INTEGER) IS + RECORD + C1, C2 : INTEGER; + END RECORD; + + TYPE REC2 (F : INTEGER := 0) IS + RECORD + E1, E2 : INTEGER; + END RECORD; + + TYPE REC3 IS NEW REC1 (D => 1); + + TYPE REC4 IS NEW REC2 (F => 2); + + PACKAGE PACK1 IS + TYPE P1 IS PRIVATE; + TYPE P2 IS PRIVATE; + TYPE P3 IS PRIVATE; + TYPE P4 IS PRIVATE; + PRIVATE + TYPE P1 IS ACCESS REC1; + TYPE P2 IS NEW REC4; + TYPE P3 IS NEW REC1 (D => 5); + TYPE P4 IS NEW REC2 (F => 7); + END PACK1; + + BEGIN + + NULL; + + END; + + RESULT; + +END A74105B; diff --git a/gcc/testsuite/ada/acats/tests/a/a74106a.ada b/gcc/testsuite/ada/acats/tests/a/a74106a.ada new file mode 100644 index 000000000..43afe5940 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a74106a.ada @@ -0,0 +1,168 @@ +-- A74106A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED +-- PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY TYPE, +-- RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE (WITH +-- OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY OF THE +-- ABOVE. + +-- PART A: TYPES NOT INVOLVING FLOATING-POINT DATA OR FIXED-POINT DATA. + + +-- RM 05/13/81 + + +WITH REPORT; +PROCEDURE A74106A IS + + USE REPORT; + +BEGIN + + TEST( "A74106A" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE " & + "TYPES CAN BE DEFINED IN TERMS OF " & + "VARIOUS OTHER TYPES" ); + + DECLARE + + TYPE ENUM IS ( A , B , C , D ); + + PACKAGE P0 IS + TYPE T0 IS PRIVATE; + PRIVATE + TYPE T0 IS NEW INTEGER; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE T1 IS PRIVATE; + TYPE T2 IS PRIVATE; + TYPE T3 IS PRIVATE; + TYPE T4 IS PRIVATE; + TYPE T5 IS PRIVATE; + TYPE T6 IS PRIVATE; + TYPE T7 IS PRIVATE; + TYPE T8 IS PRIVATE; + TYPE T9 IS PRIVATE; + TYPE TA IS PRIVATE; + TYPE TB IS PRIVATE; + TYPE TC IS PRIVATE; + TYPE TD(I : INTEGER) IS PRIVATE; + TYPE NT IS NEW ENUM; + TYPE ARR_T IS ARRAY(1..2) OF BOOLEAN; + TYPE ACC_T IS ACCESS CHARACTER; + TYPE REC_T IS RECORD T : BOOLEAN; END RECORD; + TYPE D_REC_T(I : INTEGER := 1) IS + RECORD T : ENUM; END RECORD; + PRIVATE + TYPE TY(B : BOOLEAN) IS + RECORD G : BOOLEAN; END RECORD; + TYPE TC IS NEW T0; + TYPE T1 IS RANGE 1..100; + TYPE T2 IS NEW CHARACTER RANGE 'A'..'Z'; + TYPE T3 IS NEW NT; + TYPE T4 IS ARRAY(1..2) OF INTEGER; + TYPE T5 IS NEW ARR_T; + TYPE T6 IS ACCESS ENUM; + TYPE T7 IS NEW ACC_T; + TYPE T8 IS + RECORD T : CHARACTER; END RECORD; + TYPE T9 IS NEW REC_T; + TYPE TA IS ACCESS TD; + TYPE TB IS ACCESS D_REC_T; + TYPE TD(I : INTEGER) IS + RECORD G : BOOLEAN; END RECORD; + + END P1; + + BEGIN + + NULL; + + END; + + + DECLARE + + TYPE ENUM IS ( A , B , C , D ); + + PACKAGE P0 IS + TYPE T0 IS LIMITED PRIVATE; + PRIVATE + TYPE T0 IS NEW ENUM; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE T1 IS LIMITED PRIVATE; + TYPE T2 IS LIMITED PRIVATE; + TYPE T3 IS LIMITED PRIVATE; + TYPE T4 IS LIMITED PRIVATE; + TYPE T5 IS LIMITED PRIVATE; + TYPE T6 IS LIMITED PRIVATE; + TYPE T7 IS LIMITED PRIVATE; + TYPE T8 IS LIMITED PRIVATE; + TYPE T9 IS LIMITED PRIVATE; + TYPE TA IS LIMITED PRIVATE; + TYPE TB IS LIMITED PRIVATE; + TYPE TC IS LIMITED PRIVATE; + TYPE TD(I : INTEGER) IS LIMITED PRIVATE; + TYPE NT IS NEW ENUM; + TYPE ARR_T IS ARRAY(1..2) OF BOOLEAN; + TYPE ACC_T IS ACCESS CHARACTER; + TYPE REC_T IS RECORD T : BOOLEAN; END RECORD; + TYPE D_REC_T(I : INTEGER := 1) IS + RECORD T : ENUM; END RECORD; + PRIVATE + TYPE TY(B : BOOLEAN) IS + RECORD G : BOOLEAN; END RECORD; + TYPE TC IS NEW T0; + TYPE T1 IS RANGE 1..100; + TYPE T2 IS NEW CHARACTER RANGE 'A'..'Z'; + TYPE T3 IS NEW NT; + TYPE T4 IS ARRAY(1..2) OF INTEGER; + TYPE T5 IS NEW ARR_T; + TYPE T6 IS ACCESS ENUM; + TYPE T7 IS NEW ACC_T; + TYPE T8 IS RECORD T : CHARACTER; END RECORD; + TYPE T9 IS NEW REC_T; + TYPE TA IS ACCESS TD; + TYPE TB IS ACCESS D_REC_T; + TYPE TD(I : INTEGER) IS + RECORD G : BOOLEAN; END RECORD; + + END P1; + + BEGIN + + NULL; + + END; + + + RESULT; + + +END A74106A; diff --git a/gcc/testsuite/ada/acats/tests/a/a74106b.ada b/gcc/testsuite/ada/acats/tests/a/a74106b.ada new file mode 100644 index 000000000..6f8963bff --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a74106b.ada @@ -0,0 +1,159 @@ +-- A74106B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED +-- PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY TYPE, +-- RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE (WITH +-- OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY OF THE +-- ABOVE. + +-- PART B: TYPES INVOLVING FLOATING-POINT DATA. + + +-- RM 05/08/81 + + +WITH REPORT; +PROCEDURE A74106B IS + + USE REPORT; + +BEGIN + + TEST( "A74106B" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE " & + "TYPES CAN BE DEFINED IN TERMS OF " & + "FLOATING-POINT TYPES" ); + + DECLARE + + PACKAGE P0 IS + TYPE F0 IS PRIVATE; + PRIVATE + TYPE F0 IS NEW FLOAT; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE F1 IS PRIVATE; + TYPE F2 IS PRIVATE; + TYPE F3 IS PRIVATE; + TYPE F4 IS PRIVATE; + TYPE F5 IS PRIVATE; + TYPE F6 IS PRIVATE; + TYPE F7 IS PRIVATE; + TYPE F8 IS PRIVATE; + TYPE F9 IS PRIVATE; + TYPE FA IS PRIVATE; + TYPE FB IS PRIVATE; + TYPE FC IS PRIVATE; + TYPE FD(I : INTEGER) IS PRIVATE; + TYPE NF IS NEW FLOAT; + TYPE ARR_F IS ARRAY(1..2) OF FLOAT; + TYPE ACC_F IS ACCESS FLOAT; + TYPE REC_F IS RECORD F : FLOAT; END RECORD; + TYPE D_REC_F(I : INTEGER := 1) IS + RECORD F : FLOAT; END RECORD; + PRIVATE + TYPE FY(B : BOOLEAN) IS RECORD G : FLOAT; END RECORD; + TYPE FC IS NEW F0; + TYPE F1 IS DIGITS 3; + TYPE F2 IS NEW FLOAT DIGITS 4; + TYPE F3 IS NEW NF; + TYPE F4 IS ARRAY(1..2) OF FLOAT; + TYPE F5 IS NEW ARR_F; + TYPE F6 IS ACCESS FLOAT; + TYPE F7 IS NEW ACC_F; + TYPE F8 IS RECORD F : FLOAT; END RECORD; + TYPE F9 IS NEW REC_F; + TYPE FA IS ACCESS FD; + TYPE FB IS ACCESS D_REC_F; + TYPE FD(I : INTEGER) IS RECORD G : FLOAT; END RECORD; + + END P1; + + BEGIN + + NULL; + + END; + + + DECLARE + + PACKAGE P0 IS + TYPE F0 IS LIMITED PRIVATE; + PRIVATE + TYPE F0 IS NEW FLOAT; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE F1 IS LIMITED PRIVATE; + TYPE F2 IS LIMITED PRIVATE; + TYPE F3 IS LIMITED PRIVATE; + TYPE F4 IS LIMITED PRIVATE; + TYPE F5 IS LIMITED PRIVATE; + TYPE F6 IS LIMITED PRIVATE; + TYPE F7 IS LIMITED PRIVATE; + TYPE F8 IS LIMITED PRIVATE; + TYPE F9 IS LIMITED PRIVATE; + TYPE FA IS LIMITED PRIVATE; + TYPE FB IS LIMITED PRIVATE; + TYPE FC IS LIMITED PRIVATE; + TYPE FD(I : INTEGER) IS LIMITED PRIVATE; + TYPE NF IS NEW FLOAT; + TYPE ARR_F IS ARRAY(1..2) OF FLOAT; + TYPE ACC_F IS ACCESS FLOAT; + TYPE REC_F IS RECORD F : FLOAT; END RECORD; + TYPE D_REC_F(I : INTEGER := 1) IS + RECORD F : FLOAT; END RECORD; + PRIVATE + TYPE FY(B : BOOLEAN) IS RECORD G : FLOAT; END RECORD; + TYPE FC IS NEW F0; + TYPE F1 IS DIGITS 3; + TYPE F2 IS NEW FLOAT DIGITS 4; + TYPE F3 IS NEW NF; + TYPE F4 IS ARRAY(1..2) OF FLOAT; + TYPE F5 IS NEW ARR_F; + TYPE F6 IS ACCESS FLOAT; + TYPE F7 IS NEW ACC_F; + TYPE F8 IS RECORD F : FLOAT; END RECORD; + TYPE F9 IS NEW REC_F; + TYPE FA IS ACCESS FD; + TYPE FB IS ACCESS D_REC_F; + TYPE FD(I : INTEGER) IS RECORD G : FLOAT; END RECORD; + + END P1; + + BEGIN + + NULL; + + END; + + + RESULT; + + +END A74106B; diff --git a/gcc/testsuite/ada/acats/tests/a/a74106c.ada b/gcc/testsuite/ada/acats/tests/a/a74106c.ada new file mode 100644 index 000000000..fef020354 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a74106c.ada @@ -0,0 +1,155 @@ +-- A74106C.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED +-- PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY +-- TYPE, RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE +-- (WITH OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY +-- OF THE ABOVE. + +-- PART C: TYPES INVOLVING FIXED-POINT DATA. + +-- HISTORY: +-- RM 05/11/81 CREATED ORIGINAL TEST. +-- DHH 10/15/87 CORRECTED RANGE ERRORS. + + +WITH REPORT; +PROCEDURE A74106C IS + + USE REPORT; + +BEGIN + + TEST( "A74106C" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE" & + " TYPES CAN BE DEFINED IN TERMS OF" & + " FIXED-POINT TYPES" ); + + DECLARE + + PACKAGE P0 IS + TYPE F0 IS PRIVATE; + PRIVATE + TYPE F0 IS DELTA 1.0 RANGE 0.0 .. 10.0; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE FX IS DELTA 0.1 RANGE 0.0 .. 1.0; + TYPE F1 IS PRIVATE; + TYPE F2 IS PRIVATE; + TYPE F3 IS PRIVATE; + TYPE F4 IS PRIVATE; + TYPE F5 IS PRIVATE; + TYPE F6 IS PRIVATE; + TYPE F7 IS PRIVATE; + TYPE F8 IS PRIVATE; + TYPE F9 IS PRIVATE; + TYPE FA IS PRIVATE; + TYPE FB IS PRIVATE; + TYPE FC IS PRIVATE; + TYPE NF IS DELTA 0.1 RANGE 1.0 .. 2.0; + TYPE ARR_F IS ARRAY(1..2) OF FX; + TYPE ACC_F IS ACCESS FX; + TYPE REC_F IS RECORD F : FX; END RECORD; + TYPE D_REC_F(I : INTEGER := 1) IS + RECORD F : FX; END RECORD; + PRIVATE + TYPE FC IS NEW F0; + TYPE F1 IS DELTA 100.0 RANGE -100.0 .. 900.0; + TYPE F2 IS NEW FX RANGE 0.0 .. 0.5; + TYPE F3 IS NEW NF; + TYPE F4 IS ARRAY(1..2) OF FX; + TYPE F5 IS NEW ARR_F; + TYPE F6 IS ACCESS FX; + TYPE F7 IS NEW ACC_F; + TYPE F8 IS RECORD F : FX; END RECORD; + TYPE F9 IS NEW REC_F; + TYPE FA IS ACCESS D_REC_F; + TYPE FB IS ACCESS D_REC_F; + END P1; + + BEGIN + + NULL; + + END; + + + DECLARE + + PACKAGE P0 IS + TYPE F0 IS LIMITED PRIVATE; + PRIVATE + TYPE F0 IS DELTA 1.0 RANGE 0.0 .. 10.0; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE FX IS DELTA 0.1 RANGE 0.0 .. 1.0; + TYPE F1 IS LIMITED PRIVATE; + TYPE F2 IS LIMITED PRIVATE; + TYPE F3 IS LIMITED PRIVATE; + TYPE F4 IS LIMITED PRIVATE; + TYPE F5 IS LIMITED PRIVATE; + TYPE F6 IS LIMITED PRIVATE; + TYPE F7 IS LIMITED PRIVATE; + TYPE F8 IS LIMITED PRIVATE; + TYPE F9 IS LIMITED PRIVATE; + TYPE FA IS LIMITED PRIVATE; + TYPE FB IS LIMITED PRIVATE; + TYPE FC IS LIMITED PRIVATE; + TYPE NF IS DELTA 0.1 RANGE 1.0 .. 2.0; + TYPE ARR_F IS ARRAY(1..2) OF FX; + TYPE ACC_F IS ACCESS FX; + TYPE REC_F IS RECORD F : FX; END RECORD; + TYPE D_REC_F(I : INTEGER := 1) IS + RECORD F : FX; END RECORD; + PRIVATE + TYPE FC IS NEW F0; + TYPE F1 IS DELTA 100.0 RANGE -100.0 .. 900.0; + TYPE F2 IS NEW FX RANGE 0.0 .. 0.5; + TYPE F3 IS NEW NF; + TYPE F4 IS ARRAY(1..2) OF FX; + TYPE F5 IS NEW ARR_F; + TYPE F6 IS ACCESS FX; + TYPE F7 IS NEW ACC_F; + TYPE F8 IS RECORD F : FX; END RECORD; + TYPE F9 IS NEW REC_F; + TYPE FA IS ACCESS D_REC_F; + TYPE FB IS ACCESS D_REC_F; + END P1; + + BEGIN + + NULL; + + END; + + + RESULT; + + +END A74106C; diff --git a/gcc/testsuite/ada/acats/tests/a/a74205e.ada b/gcc/testsuite/ada/acats/tests/a/a74205e.ada new file mode 100644 index 000000000..769e2e7e7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a74205e.ada @@ -0,0 +1,149 @@ +-- A74205E.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT THE ADDITIONAL OPERATIONS FOR A COMPOSITE TYPE WITH A +-- COMPONENT OF A PRIVATE TYPE ARE AVAILABLE AT THE EARLIEST +-- PLACE WITHIN THE IMMEDIATE SCOPE OF THE DECLARATION OF THE COMPOSITE +-- TYPE AND AFTER THE FULL DECLARATION OF THE PRIVATE TYPE. + +-- IN PARTICULAR, CHECH FOR THE FOLLOWING : + +-- (1) RELATIONAL OPERATORS WITH ARRAYS OF SCALAR TYPES +-- (2) EQUALITY WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES +-- (3) LOGICAL OPERATORS WITH ARRAYS OF BOOLEAN TYPES +-- (4) CATENATION WITH ARRAYS OF LIMITED PRIVATE TYPES +-- (5) INITIALIZATION WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES +-- (6) ASSIGNMENT WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES +-- (7) SELECTED COMPONENTS WITH COMPOSITES OF PRIVATE RECORD TYPES +-- (8) INDEXED COMPONENTS WITH COMPOSITES OF PRIVATE ARRAY TYPES +-- (9) SLICES WITH COMPOSITES OF PRIVATE ARRAY TYPES +-- (10) QUALIFICATION FOR COMPOSITES OF PRIVATE TYPES +-- (11) AGGREGATES FOR ARRAYS AND RECORDS OF PRIVATES TYPES +-- (12) USE OF 'SIZE FOR ARRAYS AND RECORDS OF PRIVATE TYPES + +-- DSJ 5/2/83 + +WITH REPORT ; +PROCEDURE A74205E IS + + USE REPORT ; + +BEGIN + + TEST("A74205E", "CHECK THAT ADDITIONAL OPERATIONS FOR " + & "COMPOSITE TYPES OF PRIVATE TYPES ARE " + & "AVAILABLE AT THE EARLIEST PLACE AFTER THE " + & "FULL DECLARATION AND IN THE IMMEDIATE " + & "SCOPE OF THE COMPOSITE TYPE") ; + + DECLARE + + PACKAGE PACK1 IS + TYPE LP1 IS LIMITED PRIVATE ; + PACKAGE PACK_LP IS + TYPE LP_ARR IS ARRAY (INTEGER RANGE <>) OF LP1 ; + SUBTYPE LP_ARR2 IS LP_ARR ( 1 .. 2 ) ; + SUBTYPE LP_ARR4 IS LP_ARR ( 1 .. 4 ) ; + END PACK_LP ; + + TYPE T1 IS PRIVATE ; + PACKAGE PACK2 IS + TYPE ARR IS ARRAY (INTEGER RANGE <>) OF T1 ; + SUBTYPE ARR2 IS ARR ( 1 .. 2 ) ; + SUBTYPE ARR4 IS ARR ( 1 .. 4 ) ; + END PACK2 ; + + TYPE T2 IS PRIVATE ; + TYPE T3 IS PRIVATE ; + PACKAGE PACK3 IS + TYPE ARR_T2 IS ARRAY ( 1 .. 2 ) OF T2 ; + TYPE ARR_T3 IS ARRAY ( 1 .. 2 ) OF T3 ; + END PACK3 ; + PRIVATE + TYPE LP1 IS NEW BOOLEAN ; + TYPE T1 IS NEW BOOLEAN ; + TYPE T2 IS ARRAY ( 1 .. 2 ) OF INTEGER ; + TYPE T3 IS + RECORD + C1 : INTEGER ; + END RECORD ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + + PACKAGE BODY PACK_LP IS + L1, L2 : LP_ARR2 := (TRUE,FALSE) ; -- LEGAL + A3 : LP_ARR2 := L1 ; -- LEGAL + B3 : BOOLEAN := L1 = L2 ; -- LEGAL + B4 : BOOLEAN := L1 /= L2 ; -- LEGAL + END PACK_LP ; + + PACKAGE BODY PACK2 IS + A1, A2 : ARR2 := (FALSE,TRUE) ; -- LEGAL + A4 : ARR2 := ARR2'(A1) ; -- LEGAL + B1 : BOOLEAN := A1 < A2 ; -- LEGAL + B2 : BOOLEAN := A1 >= A2 ; -- LEGAL + N3 : INTEGER := A1'SIZE ; -- LEGAL + PROCEDURE G1 (X : ARR2 := NOT A1) IS -- LEGAL + BEGIN + NULL ; + END G1 ; + + PROCEDURE G2 (X : ARR2 := A1 AND A2) IS -- LEGAL + BEGIN + NULL ; + END G2 ; + + PROCEDURE G3 (X : ARR4 := A1 & A2) IS -- LEGAL + BEGIN + NULL ; + END G3 ; + + PROCEDURE G4 (X : ARR2 := (FALSE,TRUE) ) IS -- LEGAL + BEGIN + NULL ; + END G4 ; + END PACK2 ; + + PACKAGE BODY PACK3 IS + X2 : ARR_T2 := + (1=>(1,2), 2=>(3,4)) ; -- LEGAL + X3 : ARR_T3 := + (1=>(C1=>5), 2=>(C1=>6)) ; -- LEGAL + N1 : INTEGER := X3(1).C1 ; -- LEGAL + N2 : INTEGER := X2(1)(2) ; -- LEGAL + N4 : T2 := X2(1)(1..2) ; -- LEGAL + END PACK3 ; + + END PACK1 ; + + BEGIN + + NULL ; + + END ; + + RESULT ; + +END A74205E ; diff --git a/gcc/testsuite/ada/acats/tests/a/a74205f.ada b/gcc/testsuite/ada/acats/tests/a/a74205f.ada new file mode 100644 index 000000000..23eb301e5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a74205f.ada @@ -0,0 +1,93 @@ +-- A74205F.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS A PRIVATE TYPE +-- ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON +-- CHARACTERISTICS OF THE FULL DECLARATION OF THE PRIVATE TYPE ARE MADE +-- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE +-- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE PRIVATE +-- TYPE. + +-- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES +-- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES +-- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY +-- TYPES + +-- DSJ 5/5/83 + +WITH REPORT ; +PROCEDURE A74205F IS + + USE REPORT ; + +BEGIN + + TEST("A74205F", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS TYPES " + & "OF PRIVATE TYPES ARE AVAILABLE AT THE EARLIEST " + & "PLACE IN THE IMMEDIATE SCOPE OF THE ACCESS TYPE " + & "AND AFTER THE FULL DECLARATION") ; + + DECLARE + + PACKAGE PACK1 IS + TYPE T1 IS PRIVATE ; + TYPE T2 IS PRIVATE ; + PACKAGE PACK2 IS + TYPE ACC1 IS ACCESS T1 ; + TYPE ACC2 IS ACCESS T2 ; + END PACK2 ; + PRIVATE + TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ; + TYPE T2 IS + RECORD + C1, C2 : INTEGER ; + END RECORD ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + A1 : PACK2.ACC1 := NEW T1'(2,4) ; -- LEGAL + A2 : PACK2.ACC1 := NEW T1'(6,8) ; -- LEGAL + R1 : PACK2.ACC2 := NEW T2'(3,5) ; -- LEGAL + R2 : PACK2.ACC2 := NEW T2'(7,9) ; -- LEGAL + + PACKAGE BODY PACK2 IS + X1 : INTEGER := A1(1) ; -- LEGAL + X2 : INTEGER := A1'FIRST ; -- LEGAL + X3 : INTEGER := A1'LAST ; -- LEGAL + X4 : INTEGER := A1'LENGTH ; -- LEGAL + B1 : BOOLEAN := 3 IN A1'RANGE ; -- LEGAL + X5 : INTEGER := R1.C1 ; -- LEGAL + END PACK2 ; + + END PACK1 ; + + BEGIN + + NULL ; + + END ; + + RESULT ; + +END A74205F ; diff --git a/gcc/testsuite/ada/acats/tests/a/a83009a.ada b/gcc/testsuite/ada/acats/tests/a/a83009a.ada new file mode 100644 index 000000000..da64073b3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83009a.ada @@ -0,0 +1,198 @@ +-- A83009A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A DERIVED TYPE DECLARATION AND A GENERIC +-- INSTANTIATION MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS. +-- CHECK THE CASES WHERE: +-- 1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE +-- SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN +-- THE IMPLICIT SUBPROGRAM SPECIFICATIONS. +-- 2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND +-- THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS +-- THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN +-- FOR THE GENERIC FORMAL-TYPE PARAMETERS. +-- TEST CASES WHERE THE DERIVED TYPE DECLARATIONS AND GENERIC +-- INSTANTIATIONS ARE GIVEN IN: +-- . THE VISIBLE PART OF A PACKAGE SPECIFICATION, +-- . THE PRIVATE PART OF A PACKAGE SPECIFICATION, +-- . A PACKAGE BODY, +-- . A SUBPROGRAM BODY, +-- . A BLOCK STATEMENT. +-- +-- HISTORY: +-- VCL 03-08-88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +PROCEDURE A83009A IS + TYPE ENUM IS (E1, E2, E3); + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + PACKAGE G_PACK IS + TYPE PARENT IS (E1, E2, E3); + + PROCEDURE HP (P1 : PARENT; P2 : T1); + PROCEDURE HP (P3 : PARENT; P4 : T2); + + FUNCTION HF (P1 : T1) RETURN PARENT; + FUNCTION HF (P2 : T2) RETURN PARENT; + END G_PACK; + + PACKAGE BODY G_PACK IS + PROCEDURE HP (P1 : PARENT; P2 : T1) IS + BEGIN + NULL; + END HP; + + PROCEDURE HP (P3 : PARENT; P4 : T2) IS + BEGIN + NULL; + END HP; + + FUNCTION HF (P1 : T1) RETURN PARENT IS + BEGIN + RETURN E1; + END HF; + + FUNCTION HF (P2 : T2) RETURN PARENT IS + BEGIN + RETURN E2; + END HF; + END G_PACK; +BEGIN + TEST ("A83009A", "A DERIVED TYPE DECLARATION AND A GENERIC " & + "INSTANTIATION MAY DERIVE TWO OR " & + "MORE SUBPROGRAM HOMOGRAPHS"); + + DECLARE + -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION. + + PACKAGE PACK2 IS + TYPE CHILD1 IS PRIVATE; + + PACKAGE IN_PACK2 IS + TYPE PARENT IS (E1, E2, E3); + PROCEDURE HP (P1 : PARENT; P2 : CHILD1); + PROCEDURE HP (P3 : CHILD1; P4 : PARENT); + + FUNCTION HF (P1 : CHILD1; P2 : PARENT) + RETURN PARENT; + FUNCTION HF (P3 : PARENT; P4 : CHILD1) + RETURN PARENT; + END IN_PACK2; + PRIVATE + TYPE CHILD1 IS NEW IN_PACK2.PARENT; + END PACK2; + + PACKAGE BODY PACK2 IS + TYPE CHILD2 IS NEW CHILD1; + + PACKAGE IN_BODY IS + TYPE CHILD3 IS NEW CHILD1; + END IN_BODY; + + PROCEDURE P IS + TYPE CHILD4 IS NEW CHILD1; + BEGIN + NULL; + END; + + PACKAGE BODY IN_PACK2 IS + PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS + BEGIN + NULL; + END HP; + + PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS + BEGIN + NULL; + END HP; + + FUNCTION HF (P1 : CHILD1; P2 : PARENT) + RETURN PARENT IS + BEGIN + RETURN E1; + END HF; + + FUNCTION HF (P3 : PARENT; P4 : CHILD1) + RETURN PARENT IS + BEGIN + RETURN E2; + END HF; + END IN_PACK2; + BEGIN + DECLARE + TYPE CHILD5 IS NEW CHILD1; + BEGIN + NULL; + END; + END PACK2; + BEGIN + NULL; + END; + + DECLARE + -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS. + + PACKAGE INSTANCE1 IS + NEW G_PACK (BOOLEAN, BOOLEAN); + + TYPE CHILD1 IS NEW INSTANCE1.PARENT; + + PACKAGE PACK1 IS + PACKAGE INSTANCE2 IS + NEW G_PACK (CHARACTER, CHARACTER); + + TYPE CHILD2 IS NEW INSTANCE2.PARENT; + TYPE CHILD3 IS PRIVATE; + PRIVATE + PACKAGE INSTANCE3 IS + NEW G_PACK (ENUM, ENUM); + + TYPE CHILD3 IS NEW INSTANCE3.PARENT; + END PACK1; + + PROCEDURE P1 IS + PACKAGE INSTANCE4 IS + NEW G_PACK (BOOLEAN, BOOLEAN); + + TYPE CHILD4 IS NEW INSTANCE4.PARENT; + BEGIN + NULL; + END P1; + + PACKAGE BODY PACK1 IS + PACKAGE INSTANCE5 IS + NEW G_PACK (ENUM, ENUM); + + TYPE CHILD5 IS NEW INSTANCE5.PARENT; + END PACK1; + BEGIN + NULL; + END; + + RESULT; +END A83009A; diff --git a/gcc/testsuite/ada/acats/tests/a/a83009b.ada b/gcc/testsuite/ada/acats/tests/a/a83009b.ada new file mode 100644 index 000000000..ebd9412be --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83009b.ada @@ -0,0 +1,196 @@ +-- A83009B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A DERIVED TYPE DECLARATION IN A GENERIC +-- UNIT MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS. +-- CHECK THE CASES WHERE: +-- 1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE +-- SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN +-- THE IMPLICIT SUBPROGRAM SPECIFICATIONS. +-- 2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND +-- THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS +-- THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN +-- FOR THE GENERIC FORMAL-TYPE PARAMETERS. +-- TEST CASES WHERE THE DERIVED TYPE DECLARATIONS ARE GIVEN IN: +-- . THE VISIBLE PART OF A GENERIC PACKAGE SPECIFICATION, +-- . THE PRIVATE PART OF A GENERIC PACKAGE SPECIFICATION, +-- . A GENERIC PACKAGE BODY, +-- . A GENERIC SUBPROGRAM BODY. +-- +-- HISTORY: +-- DHH 09/20/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +PROCEDURE A83009B IS + TYPE ENUM IS (E1, E2, E3); + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + PACKAGE G_PACK IS + TYPE PARENT IS (E1, E2, E3); + + PROCEDURE HP (P1 : PARENT; P2 : T1); + PROCEDURE HP (P3 : PARENT; P4 : T2); + + FUNCTION HF (P1 : T1) RETURN PARENT; + FUNCTION HF (P2 : T2) RETURN PARENT; + END G_PACK; + + PACKAGE BODY G_PACK IS + PROCEDURE HP (P1 : PARENT; P2 : T1) IS + BEGIN + NULL; + END HP; + + PROCEDURE HP (P3 : PARENT; P4 : T2) IS + BEGIN + NULL; + END HP; + + FUNCTION HF (P1 : T1) RETURN PARENT IS + BEGIN + RETURN E1; + END HF; + + FUNCTION HF (P2 : T2) RETURN PARENT IS + BEGIN + RETURN E2; + END HF; + END G_PACK; +BEGIN + TEST ("A83009B", "A DERIVED TYPE DECLARATION IN A GENERIC " & + "UNIT MAY DERIVE TWO OR MORE SUBPROGRAM " & + "HOMOGRAPHS"); + + DECLARE + -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION. + + GENERIC + PACKAGE PACK2 IS + TYPE CHILD1 IS PRIVATE; + + PACKAGE IN_PACK2 IS + TYPE PARENT IS (E1, E2, E3); + PROCEDURE HP (P1 : PARENT; P2 : CHILD1); + PROCEDURE HP (P3 : CHILD1; P4 : PARENT); + + FUNCTION HF (P1 : CHILD1; P2 : PARENT) + RETURN PARENT; + FUNCTION HF (P3 : PARENT; P4 : CHILD1) + RETURN PARENT; + END IN_PACK2; + + USE IN_PACK2; + PRIVATE + TYPE CHILD1 IS NEW IN_PACK2.PARENT; -- PRIVATE PART + END PACK2; -- OF SPEC. + + PACKAGE BODY PACK2 IS + TYPE CHILD2 IS NEW CHILD1; -- VISIBLE PART OF BODY. + + GENERIC + PACKAGE IN_BODY IS + TYPE CHILD3 IS NEW CHILD1; -- VISIBLE PART OF SPEC. + END IN_BODY; + + GENERIC + PROCEDURE P; + PROCEDURE P IS + TYPE CHILD4 IS NEW CHILD1; -- SUBPROGRAM BODY. + BEGIN + NULL; + END; + + PACKAGE BODY IN_PACK2 IS + PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS + BEGIN + NULL; + END HP; + + PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS + BEGIN + NULL; + END HP; + + FUNCTION HF (P1 : CHILD1; P2 : PARENT) + RETURN PARENT IS + BEGIN + RETURN E1; + END HF; + + FUNCTION HF (P3 : PARENT; P4 : CHILD1) + RETURN PARENT IS + BEGIN + RETURN E2; + END HF; + END IN_PACK2; + BEGIN + NULL; + END PACK2; + BEGIN + NULL; + END; + + DECLARE + -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS. + + GENERIC + PACKAGE PACK1 IS + PACKAGE INSTANCE2 IS + NEW G_PACK (CHARACTER, CHARACTER); + + TYPE CHILD2 IS NEW INSTANCE2.PARENT; + TYPE CHILD3 IS PRIVATE; + PRIVATE + PACKAGE INSTANCE3 IS + NEW G_PACK (ENUM, ENUM); + + TYPE CHILD3 IS NEW INSTANCE3.PARENT; + END PACK1; + + GENERIC + PROCEDURE P1; + PROCEDURE P1 IS + PACKAGE INSTANCE4 IS + NEW G_PACK (BOOLEAN, BOOLEAN); + + TYPE CHILD4 IS NEW INSTANCE4.PARENT; + BEGIN + NULL; + END P1; + + PACKAGE BODY PACK1 IS + PACKAGE INSTANCE5 IS + NEW G_PACK (ENUM, ENUM); + + TYPE CHILD5 IS NEW INSTANCE5.PARENT; + END PACK1; + BEGIN + NULL; + END; + + RESULT; +END A83009B; diff --git a/gcc/testsuite/ada/acats/tests/a/a83a02a.ada b/gcc/testsuite/ada/acats/tests/a/a83a02a.ada new file mode 100644 index 000000000..45bdfad04 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83a02a.ada @@ -0,0 +1,120 @@ +-- A83A02A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A LABEL IN A NESTED SUBPROGRAM OR PACKAGE CAN BE IDENTICAL +-- TO A LABEL OUTSIDE SUCH CONSTRUCT. + + +-- "INSIDE LABEL": INSIDE * PACKAGE _PACK A +-- * FUNCTION INSIDE PACKAGE _PACKFUN B +-- * PROCEDURE _PROC C +-- * PROCEDURE INSIDE BLOCK _BLOCKPROC D + +-- "OUTSIDE LABEL": INSIDE * MAIN _MAIN 1 +-- * BLOCK IN MAIN _BLOCK 2 +-- * LOOP IN BLOCK IN MAIN _BLOCKLOOP 3 +-- * LOOP IN MAIN _LOOP 4 + +-- CASES TESTED: A1 B2 A3 B4 1 2 3 4 +-- D1 C2 C3 D4 +-- D2 AB A X . X . +-- B . X . X +-- C . X X . +-- D X . . X + + +-- RM 02/09/80 + + +WITH REPORT ; +PROCEDURE A83A02A IS + + USE REPORT ; + + PROCEDURE PROC1 IS + BEGIN + << LAB_PROC_BLOCK >> NULL ; -- C2 C + << LAB_PROC_BLOCKLOOP >> NULL ; -- C3 + END PROC1 ; + + PACKAGE PACK1 IS + FUNCTION F RETURN INTEGER ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + FUNCTION F RETURN INTEGER IS + BEGIN + << LAB_PACKFUN_BLOCK >> NULL ; -- B2 B + << LAB_PACKFUN_LOOP >> NULL ; -- B4 + << LAB_PACKFUN_PACK >> NULL ; -- BA (AB) + RETURN 7 ; + END F ; + BEGIN + << LAB_PACK_MAIN >> NULL ; -- A1 A + << LAB_PACK_BLOCKLOOP >> NULL ; -- A3 + << LAB_PACKFUN_PACK >> NULL ; -- BA (AB) + END PACK1 ; + +BEGIN + + TEST( "A83A02A" , "CHECK THAT A LABEL IN A NESTED SUBPROGRAM" & + " OR PACKAGE CAN BE IDENTICAL TO A LABEL" & + " OUTSIDE SUCH CONSTRUCT" ); + + << LAB_PACK_MAIN >> NULL ; -- A1 1 + << LAB_BLOCKPROC_MAIN >> NULL ; -- D1 + + + DECLARE -- + + PROCEDURE PROC2 IS + BEGIN + << LAB_BLOCKPROC_MAIN >> NULL ; -- D1 D + << LAB_BLOCKPROC_LOOP >> NULL ; -- D4 + << LAB_BLOCKPROC_BLOCK >> NULL ; -- D2 + END PROC2 ; + + BEGIN + + << LAB_PACKFUN_BLOCK >> NULL ; -- B2 2 + << LAB_PROC_BLOCK >> NULL ; -- C2 + << LAB_BLOCKPROC_BLOCK >> NULL ; -- D2 + + FOR I IN 1..2 LOOP + << LAB_PACK_BLOCKLOOP >> NULL ; -- A3 3 + << LAB_PROC_BLOCKLOOP >> NULL ; -- C3 + END LOOP; + + END ; + + FOR I IN 1..2 LOOP + << LAB_PACKFUN_LOOP >> NULL ; -- B4 4 + << LAB_BLOCKPROC_LOOP >> NULL ; -- D4 + END LOOP; + + + RESULT ; + + +END A83A02A ; diff --git a/gcc/testsuite/ada/acats/tests/a/a83a02b.ada b/gcc/testsuite/ada/acats/tests/a/a83a02b.ada new file mode 100644 index 000000000..7613f09ae --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83a02b.ada @@ -0,0 +1,116 @@ +-- A83A02B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A LABEL IN A NESTED TASK CAN BE IDENTICAL TO A LABEL +-- OUTSIDE THE TASK. + + +-- "INSIDE LABEL": INSIDE * TASK BODY _TASK A +-- * BLOCK IN TASK BODY _TASKBLOCK B +-- * LOOP IN BLOCK IN TASK BODY _TASKBLOCKLOOP +-- * ACCEPT ST. WITHIN TASK BDY _TASKACCEPT D + +-- "OUTSIDE LABEL": INSIDE * MAIN _MAIN 1 +-- * BLOCK IN MAIN _BLOCK 2 +-- * LOOP IN BLOCK IN MAIN _BLOCKLOOP 3 +-- * LOOP IN MAIN _LOOP 4 + +-- CASES TESTED: A1 B2 A3 B4 | 1 2 3 4 +-- D1 C2 C3 D4 ---+---------- +-- A | X . X . +-- B | . X . X +-- C | . X X . +-- D | X . . X + + +-- RM 02/10/80 + + +WITH REPORT ; +PROCEDURE A83A02B IS + + USE REPORT ; + + TASK TYPE TASK1 IS + ENTRY E1 ; + END TASK1 ; + + TASK BODY TASK1 IS + BEGIN + + << LAB_TASK_MAIN >> NULL ; -- A1 A + << LAB_TASK_BLOCKLOOP >> NULL ; -- A3 + + BEGIN + + << LAB_TASKBLOCK_BLOCK >> NULL ; -- B2 B + << LAB_TASKBLOCK_LOOP >> NULL ; -- B4 + + FOR I IN 1..2 LOOP + << LAB_TASKBLOCKLOOP_BLOCK >>NULL ; -- C2 C + << LAB_TASKBLOCKLOOP_BLOCKLOOP >> + NULL ; -- C3 + END LOOP; + + END ; + + ACCEPT E1 DO + << LAB_TASKACCEPT_MAIN >> NULL ; -- D1 D + << LAB_TASKACCEPT_LOOP >> NULL ; -- D4 + END E1 ; + + END TASK1 ; + +BEGIN + + TEST( "A83A02B" , "CHECK THAT A LABEL IN A NESTED TASK" & + " CAN BE IDENTICAL TO A LABEL" & + " OUTSIDE THE TASK" ); + + << LAB_TASK_MAIN >> NULL ; -- A1 1 + << LAB_TASKACCEPT_MAIN >> NULL ; -- D1 + + + BEGIN + + << LAB_TASKBLOCK_BLOCK >> NULL ; -- B2 2 + << LAB_TASKBLOCKLOOP_BLOCK >> NULL ; -- C2 + + FOR I IN 1..2 LOOP + << LAB_TASK_BLOCKLOOP >> NULL ; -- A3 3 + << LAB_TASKBLOCKLOOP_BLOCKLOOP >> NULL ; -- C3 + END LOOP; + + END ; + + FOR I IN 1..2 LOOP + << LAB_TASKBLOCK_LOOP >> NULL ; -- B4 4 + << LAB_TASKACCEPT_LOOP >> NULL ; -- D4 + END LOOP; + + + RESULT ; + + +END A83A02B ; diff --git a/gcc/testsuite/ada/acats/tests/a/a83a06a.ada b/gcc/testsuite/ada/acats/tests/a/a83a06a.ada new file mode 100644 index 000000000..3018fcd51 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83a06a.ada @@ -0,0 +1,94 @@ +-- A83A06A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A STATEMENT LABEL INSIDE A BLOCK BODY CAN BE THE +-- SAME AS A VARIABLE, CONSTANT, NAMED LITERAL, SUBPROGRAM, +-- ENUMERATION LITERAL, TYPE, OR PACKAGE DECLARED IN THE +-- ENCLOSING BODY. + + +-- RM 02/12/80 +-- JBG 5/16/83 +-- JBG 8/21/83 +-- JRK 12/19/83 + +WITH REPORT; USE REPORT; +PROCEDURE A83A06A IS + + LAB_VAR : INTEGER; + LAB_CONST : CONSTANT INTEGER := 12; + LAB_NAMEDLITERAL : CONSTANT := 13; + TYPE ENUM IS ( AA , BB , LAB_ENUMERAL ); + TYPE LAB_TYPE IS NEW INTEGER; + + PROCEDURE LAB_PROCEDURE IS + BEGIN + NULL; + END LAB_PROCEDURE; + + FUNCTION LAB_FUNCTION RETURN INTEGER IS + BEGIN + RETURN 7; + END LAB_FUNCTION; + + PACKAGE LAB_PACKAGE IS + INT : INTEGER; + END LAB_PACKAGE; + +BEGIN + + TEST ("A83A06A", "CHECK THAT STATEMENT LABELS INSIDE A BLOCK " & + "BODY CAN BE THE SAME AS IDENTIFIERS DECLARED "& + "OUTSIDE THE BODY"); + + LAB_BLOCK_1 : BEGIN NULL; END LAB_BLOCK_1; + + LAB_LOOP_1 : LOOP EXIT; END LOOP LAB_LOOP_1; + + BEGIN + + << LAB_VAR >> -- OK. + BEGIN NULL; END; + << LAB_ENUMERAL >> NULL; -- OK. + + << LAB_PROCEDURE >> -- OK. + FOR I IN INTEGER LOOP + << LAB_CONST >> NULL; -- OK. + << LAB_TYPE >> NULL; -- OK. + << LAB_FUNCTION >> EXIT; -- OK. + END LOOP; + + << LAB_NAMEDLITERAL >> NULL; + << LAB_PACKAGE >> NULL; + END; + + LAB_BLOCK_2 : -- OK. + BEGIN NULL; END LAB_BLOCK_2; + + LAB_LOOP_2 : -- OK. + LOOP EXIT; END LOOP LAB_LOOP_2; + + RESULT; + +END A83A06A; diff --git a/gcc/testsuite/ada/acats/tests/a/a83a08a.ada b/gcc/testsuite/ada/acats/tests/a/a83a08a.ada new file mode 100644 index 000000000..5cdc30ecd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83a08a.ada @@ -0,0 +1,102 @@ +-- A83A08A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- A STATEMENT LABEL DECLARED OUTSIDE A BLOCK CAN HAVE THE SAME +-- IDENTIFIER AS AN ENTITY DECLARED IN THE BLOCK, AND A GOTO +-- STATEMENT USING THE LABEL IS LEGAL OUTSIDE THE BLOCK. + +-- HISTORY: +-- PMW 09/20/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SYSTEM; + +PROCEDURE A83A08A IS + + PASSES : INTEGER := 0; + +BEGIN + TEST ("A83A08A", "A STATEMENT LABEL DECLARED OUTSIDE A BLOCK " & + "CAN HAVE THE SAME IDENTIFIER AS AN ENTITY " & + "DECLARED IN THE BLOCK, AND A GOTO STATEMENT " & + "USING THE LABEL IS LEGAL OUTSIDE THE BLOCK"); + + GOTO LBLS; + + <> + + DECLARE + LBL : INTEGER := 1; + BEGIN + LBL := IDENT_INT (LBL); + PASSES := PASSES + 1; + END; + + <> + + BEGIN + DECLARE + TYPE STUFF IS (LBL, LBL_ONE, LBL_TWO); + ITEM : STUFF := LBL; + + FUNCTION LBLS (ITEM : STUFF) RETURN BOOLEAN IS + BEGIN + <> + CASE ITEM IS + WHEN LBL => RETURN TRUE; + WHEN LBL_ONE => PASSES := PASSES + 1; + WHEN LBL_TWO => RETURN FALSE; + END CASE; + IF PASSES < 2 THEN + PASSES := PASSES + 1; + GOTO LBL_2; + ELSE + RETURN TRUE; + END IF; + END LBLS; + + BEGIN + CASE PASSES IS + WHEN 0 => ITEM := LBL; + WHEN 1 => ITEM := LBL_ONE; + WHEN OTHERS => ITEM := LBL_TWO; + END CASE; + IF NOT LBLS (ITEM) THEN + COMMENT ("IRRELEVANT"); + END IF; + END; + END; + + + IF PASSES > 1 THEN + GOTO ENOUGH; + END IF; + GOTO LBL; + + <> + + RESULT; + +END A83A08A; diff --git a/gcc/testsuite/ada/acats/tests/a/a83c01c.ada b/gcc/testsuite/ada/acats/tests/a/a83c01c.ada new file mode 100644 index 000000000..159f3cf86 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83c01c.ada @@ -0,0 +1,83 @@ +-- A83C01C.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF +-- FORMAL PARAMETERS, LABELS, LOOP PARAMETERS, +-- VARIABLES, CONSTANTS, SUBPROGRAMS, PACKAGES, TYPES. +-- (NAMES OF COMPONENTS IN LOGICALLY NESTED RECORDS ARE TESTED IN +-- C83C01B.ADA .) +-- (NAMES OF TASKS ARE TESTED IN A83C01T.ADA .) + +-- RM 24 JUNE 1980 +-- JRK 10 NOV 1980 +-- RM 01 JAN 1982 + +WITH REPORT; +PROCEDURE A83C01C IS + + USE REPORT; + +BEGIN + + TEST( "A83C01C" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" & + " NAMES OF VARIABLES AND CONSTANTS " ) ; + + + + DECLARE + + VAR1 , VAR2 : INTEGER := 27 ; + CONST1 : CONSTANT INTEGER := 13 ; + CONST2 : CONSTANT BOOLEAN := FALSE ; + + TYPE R1A IS + RECORD + VAR1,VAR2,CONST1:INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + VAR1 : INTEGER ; + VAR2 : BOOLEAN ; + CONST1 : BOOLEAN ; + A : R1A ; + END RECORD ; + + A : R1 := ( VAR1 => VAR1 , A => ( VAR1 => VAR2 , + VAR2 => VAR2 , + CONST1 => VAR1 ) , + VAR2 => CONST2 , CONST1 => CONST2 ) ; + + BEGIN + + VAR1 := A.A.VAR2 ; + A.CONST1 := CONST2 ; + A.A.CONST1 := A.VAR1 + VAR2 ; + + END ; + + + RESULT; + +END A83C01C; diff --git a/gcc/testsuite/ada/acats/tests/a/a83c01h.ada b/gcc/testsuite/ada/acats/tests/a/a83c01h.ada new file mode 100644 index 000000000..f50ce7761 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83c01h.ada @@ -0,0 +1,99 @@ +-- A83C01H.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF +-- LABELS. + +-- RM 24 JUNE 1980 +-- JRK 10 NOV 1980 +-- RM 01 JAN 1982 + + +WITH REPORT; +PROCEDURE A83C01H IS + + USE REPORT; + +BEGIN + + TEST( "A83C01H" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" & + " NAMES OF LABELS" ) ; + + + -- TEST FOR LABELS + + DECLARE + + TYPE R1A IS + RECORD + LAB3 : INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + LAB1 : INTEGER ; + LAB2 : R1A ; + END RECORD ; + + A1 : R1 := ( 1 , ( LAB3 => 5 ) ); + + BEGIN + + << LAB1 >> + << LAB2 >> + << LAB3 >> + + A1.LAB1 := A1.LAB2.LAB3 ; + + DECLARE + + TYPE R1A IS + RECORD + LAB3 : INTEGER ; + LAB4 : INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + LAB1 : INTEGER ; + LAB2 : R1A ; + END RECORD ; + + A1 : R1 := ( 3 , ( 6 , 7 ) ); + + BEGIN + + << LAB4 >> + + A1.LAB1 := A1.LAB2.LAB3 + A1.LAB2.LAB4 ; + + END ; + + END ; + + + + RESULT; + +END A83C01H; diff --git a/gcc/testsuite/ada/acats/tests/a/a83c01i.ada b/gcc/testsuite/ada/acats/tests/a/a83c01i.ada new file mode 100644 index 000000000..3a2ec2d3a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a83c01i.ada @@ -0,0 +1,112 @@ +-- A83C01I.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF +-- LOOP PARAMETERS. + +-- RM 24 JUNE 1980 +-- JRK 10 NOV 1980 +-- RM 01 JAN 1982 + + +WITH REPORT; +PROCEDURE A83C01I IS + + USE REPORT; + +BEGIN + + TEST( "A83C01I" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" & + " NAMES OF LOOP PARAMETERS" ) ; + + + + -- TEST FOR LOOP PARAMETERS + + + DECLARE + + TYPE R1A IS + RECORD + LOOP3 : INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + LOOP1 : INTEGER ; + LOOP2 : R1A ; + END RECORD ; + + A1 : R1 := ( 3 , ( LOOP3 => 7 ) ); + + BEGIN + + FOR LOOP1 IN 0..1 LOOP + + FOR LOOP2 IN 0..2 LOOP + + FOR LOOP3 IN 0..3 LOOP + + A1.LOOP1 := A1.LOOP2.LOOP3 ; + + DECLARE + + TYPE R1A IS + RECORD + LOOP3 : INTEGER ; + LOOP4 : INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + LOOP1 : INTEGER ; + LOOP2 : R1A ; + END RECORD ; + + A1 : R1 := ( 3 , ( 6 , 7 ) ); + + BEGIN + + FOR LOOP4 IN 0..4 LOOP + + A1.LOOP1 := A1.LOOP2.LOOP3 + + A1.LOOP2.LOOP4 ; + + END LOOP ; + + END ; + + END LOOP ; + + END LOOP ; + + END LOOP ; + + END ; + + + + RESULT; + +END A83C01I; diff --git a/gcc/testsuite/ada/acats/tests/a/a85007d.ada b/gcc/testsuite/ada/acats/tests/a/a85007d.ada new file mode 100644 index 000000000..d86761d7e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a85007d.ada @@ -0,0 +1,156 @@ +-- A85007D.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT 'FIRST, 'LAST, 'LENGTH, 'RANGE, 'ADDRESS, 'CONSTRAINED, +-- AND 'SIZE CAN BE APPLIED TO RENAMED NON-ACCESS OUT FORMAL PARAMETERS +-- AND RENAMED COMPONENTS OF NON-ACCESS OUT PARAMETERS. + +-- SPS 02/21/84 (SEE A62006D-B.ADA) +-- EG 02/22/84 +-- EG 05/30/84 +-- JBG 12/2/84 + +WITH REPORT; USE REPORT; +WITH SYSTEM; + +PROCEDURE A85007D IS + + PROCEDURE Q (X : SYSTEM.ADDRESS) IS + BEGIN + NULL; + END Q; + +BEGIN + + TEST ("A85007D", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " & + "RENAMED NON-ACCESS FORMAL OUT PARAMETERS"); + + DECLARE + + TYPE ARR IS ARRAY (1 .. 2) OF BOOLEAN; + TYPE REC (D : INTEGER) IS RECORD + Y : BOOLEAN; + X : ARR; + END RECORD; + + PROCEDURE PROC (C2 : OUT ARR; + C3 : OUT REC) IS + + X : SYSTEM.ADDRESS; + I : INTEGER; + + C21 : ARR RENAMES C2; + C22 : ARR RENAMES C21; + C31 : REC RENAMES C3; + C32 : REC RENAMES C31; + C33 : ARR RENAMES C3.X; + C34 : ARR RENAMES C33; + C35 : ARR RENAMES C32.X; + C36 : BOOLEAN RENAMES C3.Y; + C37 : BOOLEAN RENAMES C36; + C38 : BOOLEAN RENAMES C32.Y; + + BEGIN + + I := C21'LENGTH; + Q(C21'ADDRESS); + I := C21'SIZE; + I := C22'LENGTH; + Q(C22'ADDRESS); + I := C22'SIZE; + + FOR I IN C21'RANGE LOOP + NULL; + END LOOP; + FOR I IN C22'RANGE LOOP + NULL; + END LOOP; + + FOR I IN C21'FIRST..C21'LAST LOOP + NULL; + END LOOP; + FOR I IN C22'FIRST..C22'LAST LOOP + NULL; + END LOOP; + + I := C31.X'LENGTH; + C3.Y := C31'CONSTRAINED; + FOR J IN C31.X'RANGE LOOP + NULL; + END LOOP; + FOR J IN C31.X'FIRST..C31.X'LAST LOOP + NULL; + END LOOP; + I := C32.X'LENGTH; + C31.Y := C32'CONSTRAINED; + FOR J IN C32.X'RANGE LOOP + NULL; + END LOOP; + FOR J IN C32.X'FIRST..C32.X'LAST LOOP + NULL; + END LOOP; + I := C33'LENGTH; + FOR J IN C33'RANGE LOOP + NULL; + END LOOP; + FOR J IN C33'FIRST..C33'LAST LOOP + NULL; + END LOOP; + I := C34'LENGTH; + FOR J IN C34'RANGE LOOP + NULL; + END LOOP; + FOR J IN C34'FIRST..C34'LAST LOOP + NULL; + END LOOP; + I := C35'LENGTH; + FOR J IN C35'RANGE LOOP + NULL; + END LOOP; + FOR J IN C35'FIRST..C35'LAST LOOP + NULL; + END LOOP; + + Q(C31.Y'ADDRESS); + I := C31.Y'SIZE; + Q(C32.Y'ADDRESS); + I := C32.Y'SIZE; + Q(C36'ADDRESS); + I := C36'SIZE; + Q(C37'ADDRESS); + I := C37'SIZE; + Q(C38'ADDRESS); + I := C38'SIZE; + + END PROC; + + BEGIN + + NULL; + + END; + + RESULT; + +END A85007D; diff --git a/gcc/testsuite/ada/acats/tests/a/a85013b.ada b/gcc/testsuite/ada/acats/tests/a/a85013b.ada new file mode 100644 index 000000000..6b77ada5e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a85013b.ada @@ -0,0 +1,89 @@ +-- A85013B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT: + +-- A) A SUBPROGRAM OR ENTRY CAN BE RENAMED WITHIN ITS OWN BODY. + +-- B) THE NEW NAME OF A SUBPROGRAM CAN BE USED IN A RENAMING +-- DECLARATION. + +-- EG 02/22/84 + +WITH REPORT; + +PROCEDURE A85013B IS + + USE REPORT; + +BEGIN + + TEST("A85013B","CHECK THAT A SUBPROGRAM CAN BE RENAMED WITHIN " & + "ITS OWN BODY AND THAT THE NEW NAME CAN BE USED" & + " IN A RENAMING DECLARATION"); + + DECLARE + + PROCEDURE PROC1 (A : BOOLEAN) IS + PROCEDURE PROC2 (B : BOOLEAN := FALSE) RENAMES PROC1; + PROCEDURE PROC3 (C : BOOLEAN := FALSE) RENAMES PROC2; + BEGIN + IF A THEN + PROC3; + END IF; + END PROC1; + + BEGIN + + PROC1 (TRUE); + + END; + + DECLARE + + TASK T IS + ENTRY E; + END T; + + TASK BODY T IS + PROCEDURE E1 RENAMES E; + PROCEDURE E2 RENAMES E1; + BEGIN + ACCEPT E DO + DECLARE + PROCEDURE E3 RENAMES E; + PROCEDURE E4 RENAMES E3; + BEGIN + NULL; + END; + END E; + END T; + + BEGIN + T.E; + END; + + RESULT; + +END A85013B; diff --git a/gcc/testsuite/ada/acats/tests/a/a87b59a.ada b/gcc/testsuite/ada/acats/tests/a/a87b59a.ada new file mode 100644 index 000000000..3760e9180 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a87b59a.ada @@ -0,0 +1,250 @@ +-- A87B59A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT BECAUSE A GENERIC ACTUAL PROGRAM PARAMETER MUST BE A +-- SUBPROGRAM, AN ENUMERATION LITERAL, OR AN ENTRY WITH THE SAME +-- PARAMETER AND RESULT TYPE PROFILE AS THE FORMAL PARAMETER, AN +-- OVERLOADED NAME APPEARING AS AN ACTUAL PARAMETER CAN BE RESOLVED. + +-- R.WILLIAMS 9/24/86 + +WITH REPORT; USE REPORT; +PROCEDURE A87B59A IS + +BEGIN + TEST ( "A87B59A", "CHECK THAT BECAUSE A GENERIC ACTUAL PROGRAM " & + "PARAMETER MUST BE A SUBPROGRAM, AN " & + "ENUMERATION LITERAL, OR AN ENTRY WITH THE " & + "SAME PARAMETER AND RESULT TYPE PROFILE AS " & + "THE FORMAL PARAMETER, AN OVERLOADED NAME " & + "APPEARING AS AN ACTUAL PARAMETER CAN BE " & + "RESOLVED" ); + + DECLARE -- A. + FUNCTION F1 RETURN INTEGER IS + BEGIN + RETURN IDENT_INT (0); + END F1; + + FUNCTION F1 RETURN BOOLEAN IS + BEGIN + RETURN IDENT_BOOL (TRUE); + END F1; + + GENERIC + TYPE T IS (<>); + WITH FUNCTION F RETURN T; + PROCEDURE P; + + PROCEDURE P IS + BEGIN + NULL; + END P; + + PROCEDURE P1 IS NEW P (INTEGER, F1); + PROCEDURE P2 IS NEW P (BOOLEAN, F1); + + BEGIN + P1; + P2; + END; -- A. + + DECLARE -- B. + FUNCTION F1 (X : INTEGER; B : BOOLEAN) RETURN INTEGER IS + BEGIN + RETURN IDENT_INT (X); + END F1; + + FUNCTION F1 (X : INTEGER; B : BOOLEAN) RETURN BOOLEAN IS + BEGIN + RETURN IDENT_BOOL (B); + END F1; + + FUNCTION F1 (B : BOOLEAN; X : INTEGER) RETURN BOOLEAN IS + BEGIN + RETURN IDENT_BOOL (B); + END F1; + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + WITH FUNCTION F (A : T1; B : T2) RETURN T1; + PROCEDURE P1; + + PROCEDURE P1 IS + BEGIN + NULL; + END P1; + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + WITH FUNCTION F (A : T1; B : T2) RETURN T2; + PROCEDURE P2; + + PROCEDURE P2 IS + BEGIN + NULL; + END P2; + + PROCEDURE PROC1 IS NEW P1 (INTEGER, BOOLEAN, F1); + PROCEDURE PROC2 IS NEW P1 (BOOLEAN, INTEGER, F1); + PROCEDURE PROC3 IS NEW P2 (INTEGER, BOOLEAN, F1); + + BEGIN + PROC1; + PROC2; + END; -- B. + + DECLARE -- C. + TYPE COLOR IS (RED, YELLOW, BLUE); + C : COLOR; + + TYPE LIGHT IS (RED, YELLOW, GREEN); + L : LIGHT; + + GENERIC + TYPE T IS (<>); + WITH FUNCTION F RETURN T; + FUNCTION GF RETURN T; + + FUNCTION GF RETURN T IS + BEGIN + RETURN T'VAL (IDENT_INT (T'POS (F))); + END GF; + + FUNCTION F1 IS NEW GF (COLOR, RED); + FUNCTION F2 IS NEW GF (LIGHT, YELLOW); + BEGIN + C := F1; + L := F2; + END; -- C. + + DECLARE -- D. + TASK TK IS + ENTRY E (X : INTEGER); + ENTRY E (X : BOOLEAN); + ENTRY E (X : INTEGER; Y : BOOLEAN); + ENTRY E (X : BOOLEAN; Y : INTEGER); + END TK; + + TASK BODY TK IS + BEGIN + LOOP + SELECT + ACCEPT E (X : INTEGER); + OR + ACCEPT E (X : BOOLEAN); + OR + ACCEPT E (X : INTEGER; Y : BOOLEAN); + OR + ACCEPT E (X : BOOLEAN; Y : INTEGER); + OR + TERMINATE; + END SELECT; + END LOOP; + END TK; + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + WITH PROCEDURE P1 (X : T1); + WITH PROCEDURE P2 (X : T1; Y : T2); + PACKAGE PKG IS + PROCEDURE P; + END PKG; + + PACKAGE BODY PKG IS + PROCEDURE P IS + BEGIN + IF EQUAL (3, 3) THEN + P1 (T1'VAL (1)); + P2 (T1'VAL (0), T2'VAL (1)); + END IF; + END P; + END PKG; + + PACKAGE PK1 IS NEW PKG (INTEGER, BOOLEAN, TK.E, TK.E); + PACKAGE PK2 IS NEW PKG (BOOLEAN, INTEGER, TK.E, TK.E); + + BEGIN + PK1.P; + PK2.P; + END; -- D. + + DECLARE -- E. + FUNCTION "+" (X, Y : BOOLEAN) RETURN BOOLEAN IS + BEGIN + RETURN IDENT_BOOL (X OR Y); + END "+"; + + GENERIC + TYPE T IS (<>); + WITH FUNCTION "+" (X, Y : T) RETURN T; + PROCEDURE P; + + PROCEDURE P IS + S : T; + BEGIN + S := "+" (T'VAL (0), T'VAL (1)); + END P; + + PROCEDURE P1 IS NEW P (BOOLEAN, "+"); + PROCEDURE P2 IS NEW P (INTEGER, "+"); + + BEGIN + P1; + P2; + END; -- E. + + DECLARE -- F. + TYPE ADD_OPS IS ('+', '-', '&'); + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + TYPE T3 IS ARRAY (POSITIVE RANGE <> ) OF T2; + X2 : T2; + X3 : T3; + WITH FUNCTION F1 RETURN T1; + WITH FUNCTION F2 (X : T2; Y : T3) RETURN T3; + PROCEDURE P; + + PROCEDURE P IS + A : T1; + S : T3 (IDENT_INT (1) .. IDENT_INT (2)); + BEGIN + A := F1; + S := F2 (X2, X3); + END P; + + PROCEDURE P1 IS NEW P (ADD_OPS, CHARACTER, STRING, + '&', "&", '&', "&"); + + BEGIN + P1; + END; -- F. + + RESULT; +END A87B59A; diff --git a/gcc/testsuite/ada/acats/tests/a/a95001c.ada b/gcc/testsuite/ada/acats/tests/a/a95001c.ada new file mode 100644 index 000000000..3826e0be4 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a95001c.ada @@ -0,0 +1,74 @@ +-- A95001C.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT IF THE BOUNDS OF THE DISCRETE RANGE OF AN ENTRY FAMILY +-- ARE INTEGER LITERALS, NAMED NUMBERS, OR ATTRIBUTES HAVING TYPE +-- UNIVERSAL_INTEGER, BUT NOT EXPRESSIONS OF TYPE UNIVERSAL_INTEGER, +-- THE INDEX (IN AN ENTRY NAME OR ACCEPT STATEMENT) IS OF THE +-- PREDEFINED TYPE INTEGER. + +-- WEI 3/4/82 +-- RJK 2/1/84 ADDED TO ACVC +-- TBN 1/7/86 RENAMED FROM B950DHA-B.ADA. ADDED NAMED CONSTANTS +-- AND ATTRIBUTES AS KINDS OF BOUNDS, AND MADE TEST +-- EXECUTABLE. +-- RJW 4/11/86 RENAMED FROM C95001C-B.ADA. + +WITH REPORT; USE REPORT; + +PROCEDURE A95001C IS + + SUBTYPE T IS INTEGER RANGE 1 .. 10; + I : INTEGER := 1; + NAMED_INT1 : CONSTANT := 1; + NAMED_INT2 : CONSTANT := 2; + + TASK T1 IS + ENTRY E1 (1 .. 2); + ENTRY E2 (NAMED_INT1 .. NAMED_INT2); + ENTRY E3 (T'POS(1) .. T'POS(2)); + END T1; + + TASK BODY T1 IS + I_INT : INTEGER := 1; + I_POS : INTEGER := 2; + BEGIN + ACCEPT E1 (I_INT); + ACCEPT E2 (I_POS); + ACCEPT E3 (T'SUCC(1)); + END T1; + +BEGIN + TEST ("A95001C", "CHECK THAT IF THE BOUNDS OF THE DISCRETE " & + "RANGE OF AN ENTRY FAMILY ARE INTEGER " & + "LITERALS, NAMED NUMBERS, OR " & + "(UNIVERSAL_INTEGER) ATTRIBUTES, THE INDEX " & + "IS OF THE PREDEFINED TYPE INTEGER"); + + T1.E1 (I); + T1.E2 (NAMED_INT2); + T1.E3 (T'SUCC(I)); + + RESULT; +END A95001C; diff --git a/gcc/testsuite/ada/acats/tests/a/a95074d.ada b/gcc/testsuite/ada/acats/tests/a/a95074d.ada new file mode 100644 index 000000000..07c0032f0 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a95074d.ada @@ -0,0 +1,82 @@ +-- A95074D.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT 'ADDRESS, 'CONSTRAINED, 'SIZE, 'POSITION, 'FIRST_BIT, +-- AND 'LAST_BIT CAN BE APPLIED TO AN OUT PARAMETER OR OUT PARAMETER +-- SUBCOMPONENT THAT DOES NOT HAVE AN ACCESS TYPE. + +-- JWC 6/25/85 + +WITH REPORT; USE REPORT; +WITH SYSTEM; +PROCEDURE A95074D IS +BEGIN + + TEST ("A95074D", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " & + "NON-ACCESS FORMAL OUT PARAMETERS"); + + DECLARE + + TYPE ARR IS ARRAY (1 .. 2) OF BOOLEAN; + + TYPE REC (D : INTEGER := 1) IS RECORD + Y : BOOLEAN; + X : ARR; + END RECORD; + + TASK T IS + ENTRY E (C1 : OUT ARR; C2 : OUT REC); + END T; + + TASK BODY T IS + X : SYSTEM.ADDRESS; + I : INTEGER; + BEGIN + IF IDENT_BOOL (FALSE) THEN + ACCEPT E (C1 : OUT ARR; C2 : OUT REC) DO + + C2.Y := C2'CONSTRAINED; + + X := C1'ADDRESS; + X := C1(1)'ADDRESS; + X := C2'ADDRESS; + X := C2.Y'ADDRESS; + + I := C1'SIZE; + I := C2.Y'SIZE; + + I := C2.X'POSITION; + I := C2.Y'FIRST_BIT; + I := C2.Y'LAST_BIT; + END E; + END IF; + END T; + + BEGIN + NULL; + END; + + RESULT; + +END A95074D; diff --git a/gcc/testsuite/ada/acats/tests/a/a97106a.ada b/gcc/testsuite/ada/acats/tests/a/a97106a.ada new file mode 100644 index 000000000..c25403296 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a97106a.ada @@ -0,0 +1,86 @@ +-- A97106A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A SELECTIVE_WAIT MAY HAVE MORE THAN ONE 'DELAY' ALTER- +-- NATIVE. + + +-- RM 4/27/1982 + + +WITH REPORT; +USE REPORT; +PROCEDURE A97106A IS + + +BEGIN + + + TEST ( "A97106A" , "CHECK THAT A SELECTIVE_WAIT MAY HAVE" & + " MORE THAN ONE 'DELAY' ALTERNATIVE" ); + + ------------------------------------------------------------------- + + + DECLARE + + + TASK TYPE TT IS + ENTRY A ; + END TT ; + + + TASK BODY TT IS + DUMMY : BOOLEAN := FALSE ; + BEGIN + + SELECT + ACCEPT A ; + OR + DELAY 2.5 ; + OR + ACCEPT A ; + OR + ACCEPT A ; + OR + DELAY 2.5 ; -- MULTIPLE 'DELAY'S PERMITTED (IF + OR -- AND ONLY IF SINGLE 'DELAY'S + DELAY 2.5 ; -- ARE PERMITTED). + OR + ACCEPT A ; + END SELECT ; + + END TT ; + + BEGIN + NULL ; + END ; + + ------------------------------------------------------------------- + + + RESULT; + + +END A97106A ; diff --git a/gcc/testsuite/ada/acats/tests/a/a99006a.ada b/gcc/testsuite/ada/acats/tests/a/a99006a.ada new file mode 100644 index 000000000..d9822f462 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/a99006a.ada @@ -0,0 +1,66 @@ +-- A99006A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT 'COUNT RETURNS A UNIVERSAL INTEGER VALUE. + +-- HISTORY: +-- DHH 03/28/88 CREATED ORIGINAL TEST. + +WITH SYSTEM; USE SYSTEM; +WITH REPORT; USE REPORT; +PROCEDURE A99006A IS + + TASK CHOICE IS + ENTRY START; + ENTRY E1; + ENTRY STOP; + END CHOICE; + + TASK BODY CHOICE IS + X : INTEGER; + BEGIN + ACCEPT START; + ACCEPT E1 DO + DECLARE + TYPE Y IS NEW INTEGER RANGE -5 .. 5; + T : Y := E1'COUNT; + BEGIN + X := E1'COUNT; + END; + END E1; + ACCEPT STOP; + END CHOICE; + +BEGIN + + TEST("A99006A", "CHECK THAT 'COUNT RETURNS A UNIVERSAL INTEGER " & + "VALUE"); + + CHOICE.START; + CHOICE.E1; + CHOICE.STOP; + + RESULT; +END A99006A; diff --git a/gcc/testsuite/ada/acats/tests/a/aa2010a.ada b/gcc/testsuite/ada/acats/tests/a/aa2010a.ada new file mode 100644 index 000000000..7feee2534 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/aa2010a.ada @@ -0,0 +1,199 @@ +-- AA2010A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT SUBUNIT NAMES CAN BE IDENTICAL TO IDENTIFIERS DECLARED IN +-- STANDARD, NAMELY, BOOLEAN, INTEGER, FLOAT, CHARACTER, ASCII, +-- NATURAL, POSITIVE, STRING, DURATION, CONSTRAINT_ERROR, +-- NUMERIC_ERROR, PROGRAM_ERROR, STORAGE_ERROR, AND TASKING_ERROR. + +-- R.WILLIAMS 9/18/86 + +PACKAGE AA2010A_TYPEDEF IS + TYPE ENUM IS (E1, E2, E3); +END AA2010A_TYPEDEF; + +WITH AA2010A_TYPEDEF; USE AA2010A_TYPEDEF; +PACKAGE AA2010A_PARENT IS + + PROCEDURE BOOLEAN; + FUNCTION INTEGER RETURN ENUM; + PACKAGE FLOAT IS END FLOAT; + + PROCEDURE CHARACTER; + FUNCTION ASCII RETURN ENUM; + + TASK NATURAL IS + ENTRY E; + END NATURAL; + + PROCEDURE POSITIVE; + FUNCTION STRING RETURN ENUM; + PACKAGE DURATION IS END DURATION; + + PROCEDURE CONSTRAINT_ERROR; + FUNCTION NUMERIC_ERROR RETURN ENUM; + + TASK PROGRAM_ERROR IS + ENTRY E; + END PROGRAM_ERROR; + + PROCEDURE STORAGE_ERROR; + FUNCTION TASKING_ERROR RETURN ENUM; + +END AA2010A_PARENT; + +PACKAGE BODY AA2010A_PARENT IS + + PROCEDURE BOOLEAN IS SEPARATE; + FUNCTION INTEGER RETURN ENUM IS SEPARATE; + PACKAGE BODY FLOAT IS SEPARATE; + + PROCEDURE CHARACTER IS SEPARATE; + FUNCTION ASCII RETURN ENUM IS SEPARATE; + TASK BODY NATURAL IS SEPARATE; + + PROCEDURE POSITIVE IS SEPARATE; + FUNCTION STRING RETURN ENUM IS SEPARATE; + PACKAGE BODY DURATION IS SEPARATE; + + PROCEDURE CONSTRAINT_ERROR IS SEPARATE; + FUNCTION NUMERIC_ERROR RETURN ENUM IS SEPARATE; + TASK BODY PROGRAM_ERROR IS SEPARATE; + + PROCEDURE STORAGE_ERROR IS SEPARATE; + FUNCTION TASKING_ERROR RETURN ENUM IS SEPARATE; + +END AA2010A_PARENT; + +SEPARATE (AA2010A_PARENT) +PROCEDURE BOOLEAN IS +BEGIN + NULL; +END; + +SEPARATE (AA2010A_PARENT) +FUNCTION INTEGER RETURN ENUM IS +BEGIN + RETURN E1; +END; + +SEPARATE (AA2010A_PARENT) +PACKAGE BODY FLOAT IS END; + +SEPARATE (AA2010A_PARENT) +PROCEDURE CHARACTER IS +BEGIN + NULL; +END; + +SEPARATE (AA2010A_PARENT) +FUNCTION ASCII RETURN ENUM IS +BEGIN + RETURN E1; +END; + +SEPARATE (AA2010A_PARENT) +TASK BODY NATURAL IS +BEGIN + ACCEPT E; +END; + +SEPARATE (AA2010A_PARENT) +PROCEDURE POSITIVE IS +BEGIN + NULL; +END; + +SEPARATE (AA2010A_PARENT) +FUNCTION STRING RETURN ENUM IS +BEGIN + RETURN E1; +END; + +SEPARATE (AA2010A_PARENT) +PACKAGE BODY DURATION IS END; + +SEPARATE (AA2010A_PARENT) +PROCEDURE CONSTRAINT_ERROR IS +BEGIN + NULL; +END; + +SEPARATE (AA2010A_PARENT) +FUNCTION NUMERIC_ERROR RETURN ENUM IS +BEGIN + RETURN E1; +END; + +SEPARATE (AA2010A_PARENT) +TASK BODY PROGRAM_ERROR IS +BEGIN + ACCEPT E; +END; + +SEPARATE (AA2010A_PARENT) +PROCEDURE STORAGE_ERROR IS +BEGIN + NULL; +END; + +SEPARATE (AA2010A_PARENT) +FUNCTION TASKING_ERROR RETURN ENUM IS +BEGIN + RETURN E1; +END; + +WITH REPORT; USE REPORT; +WITH AA2010A_TYPEDEF; USE AA2010A_TYPEDEF; +WITH AA2010A_PARENT; USE AA2010A_PARENT; +PROCEDURE AA2010A IS + E : ENUM; +BEGIN + TEST ( "AA2010A", "CHECK THAT SUBUNIT NAMES CAN BE IDENTICAL " & + "TO IDENTIFIERS DECLARED IN STANDARD, " & + "NAMELY, BOOLEAN, INTEGER, FLOAT, " & + "CHARACTER, ASCII, NATURAL, POSITIVE, " & + "STRING, DURATION, CONSTRAINT_ERROR, " & + "NUMERIC_ERROR, PROGRAM_ERROR, " & + "STORAGE_ERROR, AND TASKING_ERROR" ); + + AA2010A_PARENT.BOOLEAN; + E := AA2010A_PARENT.INTEGER; + + AA2010A_PARENT.CHARACTER; + E := AA2010A_PARENT.ASCII; + AA2010A_PARENT.NATURAL.E; + + AA2010A_PARENT.POSITIVE; + E := AA2010A_PARENT.STRING; + + AA2010A_PARENT.CONSTRAINT_ERROR; + E := AA2010A_PARENT.NUMERIC_ERROR; + AA2010A_PARENT.PROGRAM_ERROR.E; + + AA2010A_PARENT.STORAGE_ERROR; + E := AA2010A_PARENT.TASKING_ERROR; + + RESULT; +END AA2010A; diff --git a/gcc/testsuite/ada/acats/tests/a/aa2012a.ada b/gcc/testsuite/ada/acats/tests/a/aa2012a.ada new file mode 100644 index 000000000..0f72c307b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/aa2012a.ada @@ -0,0 +1,70 @@ +-- AA2012A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT A BODY STUB CAN SERVE AS AN IMPLICIT DECLARATION OF A +-- SUBPROGRAM, I.E., A PRECEDING SUBPROGRAM DECLARATION IS NOT +-- REQUIRED. + +-- R.WILLIAMS 9/18/86 + +PROCEDURE AA2012A1 IS + + I : INTEGER; + + PROCEDURE AA2012A2 IS SEPARATE; + + FUNCTION AA2012A3 RETURN INTEGER IS SEPARATE; + +BEGIN + AA2012A2; + I := AA2012A3; + +END AA2012A1; + +SEPARATE (AA2012A1) +PROCEDURE AA2012A2 IS +BEGIN + NULL; +END; + +SEPARATE (AA2012A1) +FUNCTION AA2012A3 RETURN INTEGER IS +BEGIN + RETURN 5; +END; + +WITH AA2012A1; +WITH REPORT; USE REPORT; +PROCEDURE AA2012A IS + +BEGIN + TEST ( "AA2012A", "CHECK THAT A BODY STUB CAN SERVE AS AN " & + "IMPLICIT DECLARATION OF A SUBPROGRAM, " & + "I.E., A PRECEDING SUBPROGRAM DECLARATION " & + "IS NOT REQUIRED" ); + + AA2012A1; + + RESULT; +END AA2012A; diff --git a/gcc/testsuite/ada/acats/tests/a/ac1015b.ada b/gcc/testsuite/ada/acats/tests/a/ac1015b.ada new file mode 100644 index 000000000..0e83ca556 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ac1015b.ada @@ -0,0 +1,81 @@ +-- AC1015B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT WITHIN A GENERIC SUBPROGRAM THE NAME OF THE GENERIC +-- SUBPROGRAM CAN BE USED AS AN ACTUAL PARAMETER IN AN +-- INSTANTIATION. + +-- HISTORY: +-- BCB 03/28/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; + +PROCEDURE AC1015B IS + + GENERIC + PROCEDURE P; + + PROCEDURE P IS + GENERIC + WITH PROCEDURE F; + PROCEDURE T; + + PROCEDURE T IS + BEGIN + NULL; + END T; + + PROCEDURE S IS NEW T(F => P); + + BEGIN + NULL; + END P; + + GENERIC + FUNCTION D RETURN BOOLEAN; + + FUNCTION D RETURN BOOLEAN IS + GENERIC + WITH FUNCTION L RETURN BOOLEAN; + FUNCTION A RETURN BOOLEAN; + + FUNCTION A RETURN BOOLEAN IS + BEGIN + RETURN TRUE; + END A; + + FUNCTION B IS NEW A(L => D); + + BEGIN + RETURN TRUE; + END D; + +BEGIN + TEST ("AC1015B", "CHECK THAT WITHIN A GENERIC SUBPROGRAM THE " & + "NAME OF THE GENERIC SUBPROGRAM CAN BE USED AS " & + "AN ACTUAL PARAMETER IN AN INSTANTIATION"); + + RESULT; +END AC1015B; diff --git a/gcc/testsuite/ada/acats/tests/a/ac3106a.ada b/gcc/testsuite/ada/acats/tests/a/ac3106a.ada new file mode 100644 index 000000000..1b7099e85 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ac3106a.ada @@ -0,0 +1,216 @@ +-- AC3106A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT AN ACTUAL GENERIC IN OUT PARAMETER CAN BE: +-- A) ANY SUBCOMPONENT THAT DOES NOT DEPEND ON A DISCRIMINANT, +-- EVEN IF THE ENCLOSING VARIABLE IS UNCONSTRAINED; +-- B) ANY SUBCOMPONENT OF AN UNCONSTAINED VARIABLE OF A +-- RECORD TYPE IF THE DISCRIMINANTS OF THE +-- VARIABLE DO NOT HAVE DEFAULTS AND THE VARIABLE IS NOT +-- A GENERIC FORMAL IN OUT PARAMETER; +-- C) ANY COMPONENT OF AN OBJECT DESIGNATED BY AN ACCESS +-- VALUE. + +-- HISTORY: +-- RJW 11/07/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +PROCEDURE AC3106A IS + + SUBTYPE INT IS INTEGER RANGE 0 .. 10; + + TYPE REC (D : INT := 0) IS RECORD + A : INTEGER := 5; + CASE D IS + WHEN OTHERS => + V : INTEGER := 5; + END CASE; + END RECORD; + + TYPE AR_REC IS ARRAY (1 .. 10) OF REC; + + TYPE R_REC IS RECORD + E : REC; + END RECORD; + + TYPE A_STRING IS ACCESS STRING; + TYPE A_REC IS ACCESS REC; + TYPE A_AR_REC IS ACCESS AR_REC; + TYPE A_R_REC IS ACCESS R_REC; + + TYPE DIS (L : INT := 1) IS RECORD + S : STRING (1 .. L) := "A"; + R : REC (L); + AS : A_STRING (1 .. L) := NEW STRING (1 .. L); + AR : A_REC (L) := NEW REC (1); + RC : REC (3); + ARU : A_REC := NEW REC; + V_AR : AR_REC; + V_R : R_REC; + AC_AR : A_AR_REC := NEW AR_REC; + AC_R : A_R_REC := NEW R_REC; + END RECORD; + + TYPE A_DIS IS ACCESS DIS; + AD : A_DIS := NEW DIS; + + TYPE DIS2 (L : INT) IS RECORD + S : STRING (1 .. L); + R : REC (L); + AS : A_STRING (1 .. L); + AR : A_REC (L); + END RECORD; + + X : DIS; + + SUBTYPE REC3 IS REC (3); + + GENERIC + GREC3 : IN OUT REC3; + PACKAGE PREC3 IS END PREC3; + + SUBTYPE REC0 IS REC (0); + + GENERIC + GREC0 : IN OUT REC0; + PACKAGE PREC0 IS END PREC0; + + GENERIC + GINT : IN OUT INTEGER; + PACKAGE PINT IS END PINT; + + GENERIC + GA_REC : IN OUT A_REC; + PACKAGE PA_REC IS END PA_REC; + + GENERIC + GAR_REC : IN OUT AR_REC; + PACKAGE PAR_REC IS END PAR_REC; + + GENERIC + GR_REC : IN OUT R_REC; + PACKAGE PR_REC IS END PR_REC; + + GENERIC + GA_AR_REC : IN OUT A_AR_REC; + PACKAGE PA_AR_REC IS END PA_AR_REC; + + GENERIC + GA_R_REC : IN OUT A_R_REC; + PACKAGE PA_R_REC IS END PA_R_REC; + + TYPE BUFFER (SIZE : INT) IS RECORD + POS : NATURAL := 0; + VAL : STRING (1 .. SIZE); + END RECORD; + + SUBTYPE BUFF_5 IS BUFFER (5); + + GENERIC + Y : IN OUT CHARACTER; + PACKAGE P_CHAR IS END P_CHAR; + + SUBTYPE STRING5 IS STRING (1 .. 5); + GENERIC + GSTRING : STRING5; + PACKAGE P_STRING IS END P_STRING; + + GENERIC + GA_STRING : A_STRING; + PACKAGE P_A_STRING IS END P_A_STRING; + + GENERIC + X : IN OUT BUFF_5; + PACKAGE P_BUFF IS + RX : BUFF_5 RENAMES X; + END P_BUFF; + + Z : BUFFER (1) := (SIZE => 1, POS =>82, VAL =>"R"); +BEGIN + TEST ("AC3106A", "CHECK THE PERMITTED FORMS OF AN ACTUAL " & + "GENERIC IN OUT PARAMETER"); + + DECLARE -- A) + PACKAGE NPINT3 IS NEW PINT (X.RC.A); + PACKAGE NPINT4 IS NEW PINT (X.RC.V); + PACKAGE NPREC3 IS NEW PREC3 (X.RC); + PACKAGE NPA_REC IS NEW PA_REC (X.ARU); + PACKAGE NPINT5 IS NEW PINT (X.ARU.A); + PACKAGE NPINT6 IS NEW PINT (X.ARU.V); + PACKAGE NPAR_REC IS NEW PAR_REC (X.V_AR); + PACKAGE NPREC01 IS NEW PREC0 (X.V_AR (1)); + PACKAGE NPR_REC IS NEW PR_REC (X.V_R); + PACKAGE NPREC02 IS NEW PREC0 (X.V_R.E); + PACKAGE NPINT7 IS NEW PINT (X.V_R.E.A); + + PACKAGE NP_BUFF IS NEW P_BUFF (Z); + USE NP_BUFF; + + PACKAGE NP_CHAR3 IS NEW P_CHAR (RX.VAL (1)); + + PROCEDURE PROC (X : IN OUT BUFFER) IS + PACKAGE NP_CHAR4 IS NEW P_CHAR (X.VAL (1)); + BEGIN + NULL; + END; + BEGIN + NULL; + END; -- A) + + DECLARE -- B) + PROCEDURE PROC (Y : IN OUT DIS2) IS + PACKAGE NP_STRING IS NEW P_STRING (Y.S); + PACKAGE NP_CHAR IS NEW P_CHAR (Y.S (1)); + PACKAGE NP_A_STRING IS NEW P_A_STRING (Y.AS); + PACKAGE NP_CHAR2 IS NEW P_CHAR (Y.AS (1)); + PACKAGE NPINT3 IS NEW PINT (Y.R.A); + PACKAGE NPINT4 IS NEW PINT (Y.R.V); + PACKAGE NPREC3 IS NEW PREC3 (Y.R); + PACKAGE NPA_REC IS NEW PA_REC (Y.AR); + PACKAGE NPINT5 IS NEW PINT (Y.AR.A); + PACKAGE NPINT6 IS NEW PINT (Y.AR.V); + BEGIN + NULL; + END; + BEGIN + NULL; + END; -- B) + + DECLARE -- C) + PACKAGE NP_CHAR IS NEW P_CHAR (AD.S (1)); + PACKAGE NP_A_STRING IS NEW P_A_STRING (AD.AS); + PACKAGE NP_CHAR2 IS NEW P_CHAR (AD.AS (1)); + PACKAGE NPINT3 IS NEW PINT (AD.R.A); + PACKAGE NPINT4 IS NEW PINT (AD.R.V); + PACKAGE NPREC3 IS NEW PREC3 (AD.R); + PACKAGE NPA_REC IS NEW PA_REC (AD.AR); + PACKAGE NPINT5 IS NEW PINT (AD.AR.A); + PACKAGE NPINT6 IS NEW PINT (AD.AR.V); + BEGIN + NULL; + END; -- C) + + RESULT; +END AC3106A; diff --git a/gcc/testsuite/ada/acats/tests/a/ac3206a.ada b/gcc/testsuite/ada/acats/tests/a/ac3206a.ada new file mode 100644 index 000000000..df535a945 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ac3206a.ada @@ -0,0 +1,120 @@ +-- AC3206A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT AN INSTANTIATION IS LEGAL IF A FORMAL PRIVATE TYPE IS +-- USED IN A CONSTANT DECLARATION AND THE ACTUAL PARAMETER IS A +-- TYPE WITH DISCRIMINANTS THAT DO AND DO NOT HAVE DEFAULTS. (CHECK +-- CASES THAT USED TO BE FORBIDDEN). + +-- HISTORY: +-- DHH 09/16/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +PROCEDURE AC3206A IS + +BEGIN + TEST ("AC3206A", "CHECK THAT AN INSTANTIATION IS LEGAL IF A " & + "FORMAL PRIVATE TYPE IS USED IN A CONSTANT " & + "DECLARATION AND THE ACTUAL PARAMETER IS A " & + "TYPE WITH DISCRIMINANTS THAT DO AND DO NOT " & + "HAVE DEFAULTS"); + + DECLARE -- CHECK DEFAULTS LEGAL UNDER AI-37. + + GENERIC + TYPE GEN IS PRIVATE; + INIT : GEN; + PACKAGE GEN_PACK IS + CONST : CONSTANT GEN := INIT; + SUBTYPE NEW_GEN IS GEN; + END GEN_PACK; + + TYPE REC(A : INTEGER := 4) IS + RECORD + X : INTEGER; + Y : BOOLEAN; + END RECORD; + + PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE)); + USE P; + + CON : CONSTANT P.NEW_GEN := (4, 5, FALSE); + + BEGIN + NULL; + END; + + DECLARE + + GENERIC + TYPE GEN(DIS : INTEGER) IS PRIVATE; + INIT : GEN; + PACKAGE GEN_PACK IS + CONST : CONSTANT GEN := INIT; + SUBTYPE NEW_GEN IS GEN(4); + END GEN_PACK; + + TYPE REC(A : INTEGER := 4) IS + RECORD + X : INTEGER; + Y : BOOLEAN; + END RECORD; + + PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE)); + USE P; + + CON : CONSTANT P.NEW_GEN := (4, 5, FALSE); + + BEGIN + NULL; + END; + + DECLARE + + GENERIC + TYPE GEN(DIS : INTEGER) IS PRIVATE; + INIT : GEN; + PACKAGE GEN_PACK IS + CONST : CONSTANT GEN := INIT; + SUBTYPE NEW_GEN IS GEN(4); + END GEN_PACK; + + TYPE REC(A : INTEGER) IS + RECORD + X : INTEGER; + Y : BOOLEAN; + END RECORD; + + PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE)); + USE P; + + CON : CONSTANT P.NEW_GEN := (4, 5, FALSE); + + BEGIN + NULL; + END; + + RESULT; +END AC3206A; diff --git a/gcc/testsuite/ada/acats/tests/a/ac3207a.ada b/gcc/testsuite/ada/acats/tests/a/ac3207a.ada new file mode 100644 index 000000000..16057b9ad --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ac3207a.ada @@ -0,0 +1,92 @@ +-- AC3207A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT AN INSTANTIATION IS LEGAL IF A FORMAL PARAMETER +-- HAVING A LIMITED PRIVATE TYPE WITHOUT DISCRIMINANTS IS USED TO +-- DECLARE AN OBJECT IN A BLOCK THAT CONTAINS A SELECTIVE WAIT +-- WITH A TERMINATE ALTERNATIVE, AND THE ACTUAL PARAMETER'S BASE +-- TYPE IS A TASK TYPE OR A TYPE WITH A SUBCOMPONENT OF A TASK TYPE. + +-- HISTORY: +-- DHH 09/16/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +PROCEDURE AC3207A IS + + GENERIC + TYPE PRIV IS LIMITED PRIVATE; + PACKAGE GEN_P IS + TASK T1 IS + ENTRY E; + END T1; + END GEN_P; + + TASK TYPE TASK_T IS + END TASK_T; + + TYPE REC IS + RECORD + OBJ : TASK_T; + END RECORD; + + PACKAGE BODY GEN_P IS + TASK BODY T1 IS + BEGIN + DECLARE + OBJ : PRIV; + BEGIN + SELECT + ACCEPT E; + OR + TERMINATE; + END SELECT; + END; + END T1; + END GEN_P; + + TASK BODY TASK_T IS + BEGIN + NULL; + END; + + PACKAGE P IS NEW GEN_P(TASK_T); + PACKAGE NEW_P IS NEW GEN_P(REC); + +BEGIN + TEST ("AC3207A", "CHECK THAT AN INSTANTIATION IS LEGAL IF A " & + "FORMAL PARAMETER HAVING A LIMITED PRIVATE " & + "TYPE WITHOUT DISCRIMINANTS IS USED TO " & + "DECLARE AN OBJECT IN A BLOCK THAT CONTAINS " & + "A SELECTIVE WAIT WITH A TERMINATE " & + "ALTERNATIVE, AND THE ACTUAL PARAMETER'S BASE " & + "TYPE IS A TASK TYPE OR A TYPE WITH A " & + "SUBCOMPONENT OF A TASK TYPE"); + + P.T1.E; + + NEW_P.T1.E; + + RESULT; +END AC3207A; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7001b.ada b/gcc/testsuite/ada/acats/tests/a/ad7001b.ada new file mode 100644 index 000000000..7e14d18b7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7001b.ada @@ -0,0 +1,66 @@ +-- AD7001B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE +-- IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR THE UNIT +-- CONTAINING THE REFERENCES. + +-- HISTORY: +-- JET 09/08/87 CREATED ORIGINAL TEST. +-- VCL 03/30/88 CREATED NAMED NUMBERS WITH VALUES OF +-- SYSTEM.MIN_INT AND SYSTEM.MAX_INT. DELETED +-- ASSIGNMENTS OF MIN_INT AND MAX_INT TO INTEGER +-- VARIABLES. + +WITH SYSTEM; +WITH REPORT; USE REPORT; + +PROCEDURE AD7001B IS + + CHECK_ADDRESS : SYSTEM.ADDRESS; + CHECK_NAME : SYSTEM.NAME := SYSTEM.SYSTEM_NAME; + CHECK_PRIORITY : SYSTEM.PRIORITY; + I : INTEGER; + F : FLOAT; + SMALL : CONSTANT := SYSTEM.MIN_INT; + LARGE : CONSTANT := SYSTEM.MAX_INT; + MEM : CONSTANT := SYSTEM.MEMORY_SIZE; + +BEGIN + + TEST ("AD7001B", "CHECK THAT A DECLARATION IN PACKAGE " & + "SYSTEM IS ACCESSIBLE IF A WITH CLAUSE " & + "NAMING SYSTEM IS PROVIDED FOR THE UNIT " & + "CONTAINING THE REFERENCES"); + + I := SYSTEM.STORAGE_UNIT; + I := SYSTEM.MAX_DIGITS; + I := SYSTEM.MAX_MANTISSA; + F := SYSTEM.FINE_DELTA; + F := SYSTEM.TICK; + + RESULT; + +END AD7001B; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada b/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada new file mode 100644 index 000000000..7b4658317 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada @@ -0,0 +1,65 @@ +-- AD7001C0M.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE +-- IN A LIBRARY PACKAGE BODY IF A WITH CLAUSE NAMING SYSTEM +-- IS PROVIDED FOR THE PACKAGE SPECIFICATION, ALTHOUGH IN A +-- SEPARATE FILE. + +-- HISTORY: +-- JET 09/09/87 CREATED ORIGINAL TEST. +-- RJW 05/03/88 REVISED AND ENTERED TEST INTO ACVC. +-- PWN 05/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL. + +-- THIS FILE CONTAINS PACKAGE SPEC AD7001C_PACKAGE AND THE MAIN +-- PROCEDURE FOR TEST AD7001C. FILE AD7001C1.ADA CONTAINS +-- THE PACKAGE BODY FOR THE PACKAGE SPEC AND IS ALSO REQUIRED +-- FOR TEST EXECUTION. + +WITH SYSTEM; + +PACKAGE AD7001C_PACKAGE IS + + I : INTEGER; + F : FLOAT; + + PROCEDURE REQUIRE_BODY; + +END AD7001C_PACKAGE; + + +WITH AD7001C_PACKAGE; USE AD7001C_PACKAGE; +WITH REPORT; USE REPORT; + +PROCEDURE AD7001C0M IS + +BEGIN + TEST ("AD7001C", "CHECK THAT A DECLARATION IN PACKAGE SYSTEM " & + "IS ACCESSIBLE IN A LIBRARY PACKAGE BODY IF " & + "A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR " & + "THE PACKAGE SPECIFICATION, ALTHOUGH IN A " & + "SEPARATE FILE"); + RESULT; +END AD7001C0M; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada b/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada new file mode 100644 index 000000000..f7fd898a9 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada @@ -0,0 +1,60 @@ +-- AD7001C1.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE +-- IN A LIBRARY PACKAGE BODY IF A WITH CLAUSE NAMING SYSTEM +-- IS PROVIDED FOR THE PACKAGE SPECIFICATION, ALTHOUGH IN ANOTHER +-- FILE. + +-- HISTORY: +-- JET 09/09/87 CREATED ORIGINAL TEST. +-- RJW 05/03/88 REVISED AND ENTERED IN ACVC. +-- PWN 05/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL. + +-- THIS FILE CONTAINS THE PACKAGE BODY FOR PACKAGE AD7001C_PACKAGE. +-- FILE AD7001C0M.ADA CONTAINS THE PACKAGE SPEC AND MAIN PROCEDURE +-- FOR TEST AD7001C AND IS ALSO REQUIRED FOR TEST EXECUTION. + +PACKAGE BODY AD7001C_PACKAGE IS + + CHECK_ADDRESS : SYSTEM.ADDRESS; + CHECK_NAME : SYSTEM.NAME := SYSTEM.SYSTEM_NAME; + CHECK_PRIORITY : SYSTEM.PRIORITY; + MEM_SIZE : CONSTANT := SYSTEM.MEMORY_SIZE; + + TYPE INTRANGE IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT; + + PROCEDURE REQUIRE_BODY IS + BEGIN + NULL; + END; + +BEGIN + I := SYSTEM.STORAGE_UNIT; + I := SYSTEM.MAX_DIGITS; + I := SYSTEM.MAX_MANTISSA; + F := SYSTEM.FINE_DELTA; + F := SYSTEM.TICK; +END AD7001C_PACKAGE; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada b/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada new file mode 100644 index 000000000..0973e006c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada @@ -0,0 +1,60 @@ +-- AD7001D0M.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE +-- IN A SUBUNIT IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED +-- FOR THE MAIN UNIT CONTAINING THE SUBUNIT, ALTHOUGH IN A +-- SEPARATE FILE. + +-- HISTORY: +-- JET 09/09/87 CREATED ORIGINAL TEST. +-- RJW 05/03/88 REVISED AND ENTERED TEST INTO ACVC. + +-- THIS FILE CONTAINS THE MAIN PROCEDURE FOR TEST AD7001D. FILE +-- AD7001D1.ADA CONTAINS THE PACKAGE BODY FOR THE SUBUNIT PACKAGE +-- SPEC AND IS ALSO REQUIRED FOR TEST EXECUTION. + +WITH SYSTEM; +WITH REPORT; USE REPORT; + +PROCEDURE AD7001D0M IS + + PACKAGE AD7001D_PACKAGE IS + + I : INTEGER; + F : FLOAT; + + END AD7001D_PACKAGE; + + PACKAGE BODY AD7001D_PACKAGE IS SEPARATE; + +BEGIN + TEST ("AD7001D", "CHECK THAT A DECLARATION IN PACKAGE SYSTEM " & + "IS ACCESSIBLE IN A SUBUNIT IF A WITH CLAUSE " & + "NAMING SYSTEM IS PROVIDED FOR THE MAIN UNIT " & + "CONTAINING THE SUBUNIT, ALTHOUGH IN A " & + "SEPARATE FILE"); + RESULT; +END AD7001D0M; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada b/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada new file mode 100644 index 000000000..fea236add --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada @@ -0,0 +1,55 @@ +-- AD7001D1.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE IN +-- A SUBUNIT IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR THE +-- MAIN UNIT CONTAINING THE SUBUNIT, ALTHOUGH IN A SEPARATE +-- FILE. + +-- HISTORY: +-- JET 09/09/87 CREATED ORIGINAL TEST. + +-- THIS FILE CONTAINS THE PACKAGE BODY FOR PACKAGE AD7001D_PACKAGE. +-- FILE AD7001D0M.ADA CONTAINS THE PACKAGE SPEC AND MAIN PROCEDURE +-- FOR TEST AD7001D AND IS ALSO REQUIRED FOR TEST EXECUTION. + +SEPARATE (AD7001D0M) + +PACKAGE BODY AD7001D_PACKAGE IS + + CHECK_ADDRESS : SYSTEM.ADDRESS; + CHECK_NAME : SYSTEM.NAME := SYSTEM.SYSTEM_NAME; + CHECK_PRIORITY : SYSTEM.PRIORITY; + MEM_SIZE : CONSTANT := SYSTEM.MEMORY_SIZE; + + TYPE INTRANGE IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT; + +BEGIN + I := SYSTEM.STORAGE_UNIT; + I := SYSTEM.MAX_DIGITS; + I := SYSTEM.MAX_MANTISSA; + F := SYSTEM.FINE_DELTA; + F := SYSTEM.TICK; +END AD7001D_PACKAGE; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7006a.ada b/gcc/testsuite/ada/acats/tests/a/ad7006a.ada new file mode 100644 index 000000000..1154fe30f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7006a.ada @@ -0,0 +1,47 @@ +-- AD7006A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT THE CONSTANT 'SYSTEM.MEMORY_SIZE' IS DECLARED AND +-- THAT IT IS A STATIC UNIVERSAL INTEGER. + +-- HISTORY: +-- VCL 09/14/87 CREATED ORIGINAL TEST. +-- RJW 06/13/89 MODIFIED TEST AND REMOVED INTEGER VARIABLE. + +WITH SYSTEM; +WITH REPORT; USE REPORT; +PROCEDURE AD7006A IS +BEGIN + TEST ("AD7006A", "THE CONSTANT 'SYSTEM.MEMORY_SIZE' IS " & + "DECLARED AND IT IS A STATIC UNIVERSAL " & + "INTEGER"); + + DECLARE + MY_MSIZE : CONSTANT := SYSTEM.MEMORY_SIZE - 1; + BEGIN + RESULT; + END; + +END AD7006A; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7101a.ada b/gcc/testsuite/ada/acats/tests/a/ad7101a.ada new file mode 100644 index 000000000..d0ee56872 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7101a.ada @@ -0,0 +1,51 @@ +-- AD7101A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT MIN_INT AND MAX_INT ARE DECLARED IN PACKAGE SYSTEM +-- AND THAT BOTH ARE STATIC AND HAVE TYPE . + +-- HISTORY: +-- JET 09/10/87 CREATED ORIGINAL TEST. + +WITH SYSTEM; +WITH REPORT; USE REPORT; + +PROCEDURE AD7101A IS + +U_MIN : CONSTANT := SYSTEM.MIN_INT; +U_MAX : CONSTANT := SYSTEM.MAX_INT; + +TYPE S_MIN IS RANGE SYSTEM.MIN_INT .. 7; +TYPE S_MAX IS RANGE 7 .. SYSTEM.MAX_INT; + +BEGIN + + TEST ("AD7101A", "CHECK THAT MIN_INT AND MAX_INT ARE DECLARED " & + "IN PACKAGE SYSTEM AND THAT BOTH ARE STATIC " & + "AND HAVE TYPE "); + + RESULT; + +END AD7101A; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7101c.ada b/gcc/testsuite/ada/acats/tests/a/ad7101c.ada new file mode 100644 index 000000000..7b65d75a5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7101c.ada @@ -0,0 +1,50 @@ +-- AD7101C.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT TYPE DEFINITIONS WITH RANGES -MAX_INT .. MAX_INT +-- AND MIN_INT .. MAX_INT ARE ACCEPTED. + +-- HISTORY: +-- JET 09/10/87 CREATED ORIGINAL TEST. +-- VCL 03/30/88 CHANGED INTEGER SUBTYPE DECLARATIONS TO TYPE +-- DEFINITIONS. + +WITH SYSTEM; USE SYSTEM; +WITH REPORT; USE REPORT; + +PROCEDURE AD7101C IS + + TYPE CHECK1 IS RANGE -MAX_INT .. MAX_INT; + TYPE CHECK2 IS RANGE MIN_INT .. MAX_INT; + +BEGIN + + TEST ("AD7101C", "CHECK THAT TYPE DEFINITIONS WITH RANGES " & + "-MAX_INT .. MAX_INT AND MIN_INT .. MAX_INT " & + "ARE ACCEPTED"); + + RESULT; + +END AD7101C; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7102a.ada b/gcc/testsuite/ada/acats/tests/a/ad7102a.ada new file mode 100644 index 000000000..8f517fc20 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7102a.ada @@ -0,0 +1,50 @@ +-- AD7102A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT THE CONSTANT MAX_DIGITS IS DECLARED WITHIN THE +-- PACKAGE SYSTEM, THAT ITS TYPE IS , AND THAT +-- ITS VALUE IS STATIC. + +-- HISTORY: +-- BCB 09/10/87 CREATED ORIGINAL TEST. + +WITH SYSTEM; +WITH REPORT; USE REPORT; + +PROCEDURE AD7102A IS + + U_DIGITS : CONSTANT := SYSTEM.MAX_DIGITS; + + TYPE S_DIGITS IS RANGE 7 .. SYSTEM.MAX_DIGITS; + +BEGIN + + TEST ("AD7102A", "CHECK THAT THE CONSTANT MAX_DIGITS IS " & + "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " & + "TYPE IS , AND THAT ITS " & + "VALUE IS STATIC"); + RESULT; + +END AD7102A; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7103a.ada b/gcc/testsuite/ada/acats/tests/a/ad7103a.ada new file mode 100644 index 000000000..55fc0c154 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7103a.ada @@ -0,0 +1,50 @@ +-- AD7103A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT THE CONSTANT MAX_MANTISSA IS DECLARED WITHIN THE +-- PACKAGE SYSTEM, THAT ITS TYPE IS , AND THAT +-- ITS VALUE IS STATIC. + +-- HISTORY: +-- BCB 09/10/87 CREATED ORIGINAL TEST. + +WITH SYSTEM; +WITH REPORT; USE REPORT; + +PROCEDURE AD7103A IS + + U_MANTISSA : CONSTANT := SYSTEM.MAX_MANTISSA; + + TYPE S_MANTISSA IS RANGE 7 .. SYSTEM.MAX_MANTISSA; + +BEGIN + + TEST ("AD7103A", "CHECK THAT THE CONSTANT MAX_MANTISSA IS " & + "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " & + "TYPE IS , AND THAT ITS " & + "VALUE IS STATIC"); + RESULT; + +END AD7103A; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7103c.ada b/gcc/testsuite/ada/acats/tests/a/ad7103c.ada new file mode 100644 index 000000000..695eae3e2 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7103c.ada @@ -0,0 +1,50 @@ +-- AD7103C.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT THE CONSTANT FINE_DELTA IS DECLARED WITHIN THE +-- PACKAGE SYSTEM, THAT ITS TYPE IS , AND THAT +-- ITS VALUE IS STATIC. + +-- HISTORY: +-- BCB 09/10/87 CREATED ORIGINAL TEST. + +WITH SYSTEM; +WITH REPORT; USE REPORT; + +PROCEDURE AD7103C IS + + U_DELTA : CONSTANT := SYSTEM.FINE_DELTA; + + TYPE S_DELTA IS DELTA SYSTEM.FINE_DELTA RANGE -1.0 .. 1.0; + +BEGIN + + TEST ("AD7103C", "CHECK THAT THE CONSTANT FINE_DELTA IS " & + "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " & + "TYPE IS , AND THAT ITS " & + "VALUE IS STATIC"); + RESULT; + +END AD7103C; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7104a.ada b/gcc/testsuite/ada/acats/tests/a/ad7104a.ada new file mode 100644 index 000000000..204a6e0f5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7104a.ada @@ -0,0 +1,50 @@ +-- AD7104A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT THE CONSTANT TICK IS DECLARED WITHIN THE PACKAGE +-- SYSTEM, THAT ITS TYPE IS , AND THAT ITS VALUE +-- IS STATIC. + +-- HISTORY: +-- BCB 09/10/87 CREATED ORIGINAL TEST. + +WITH SYSTEM; +WITH REPORT; USE REPORT; + +PROCEDURE AD7104A IS + + U_TICK: CONSTANT := SYSTEM.TICK; + + F : FLOAT := SYSTEM.TICK; + +BEGIN + + TEST ("AD7104A", "CHECK THAT THE CONSTANT TICK IS DECLARED " & + "WITHIN THE PACKAGE SYSTEM, THAT ITS TYPE IS " & + ", AND THAT ITS VALUE IS STATIC"); + + RESULT; + +END AD7104A; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7201a.ada b/gcc/testsuite/ada/acats/tests/a/ad7201a.ada new file mode 100644 index 000000000..e350277d8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7201a.ada @@ -0,0 +1,98 @@ +-- AD7201A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT THE PREFIX OF THE 'ADDRESS ATTRIBUTE CAN DENOTE A +-- PACKAGE, SUBPROGRAM, TASK TYPE, SINGLE TASK, AND LABEL. + +-- HISTORY: +-- DHH 09/01/88 CREATED ORIGINAL TEST. +-- RJW 02/23/90 REMOVED TESTS FOR THE 'ADDRESS ATTRIBUTE APPLIED TO +-- A GENERIC UNIT. REMOVED DECLARATION OF TYPE +-- "COLOR". +-- DTN 11/22/91 DELETED SUBPART (A). + +WITH SYSTEM; +WITH REPORT; USE REPORT; +PROCEDURE AD7201A IS + + SUBTYPE MY_ADDRESS IS SYSTEM.ADDRESS; + +BEGIN + TEST ("AD7201A", "CHECK THAT THE PREFIX OF THE 'ADDRESS " & + "ATTRIBUTE CAN DENOTE A PACKAGE, " & + "SUBPROGRAM, TASK TYPE, SINGLE TASK, AND LABEL"); + + DECLARE + PACKAGE B IS + END B; + B1 : BOOLEAN := (B'ADDRESS IN MY_ADDRESS); + + PROCEDURE C; + C1 : BOOLEAN := (C'ADDRESS IN MY_ADDRESS); + + FUNCTION D RETURN BOOLEAN; + D1 : BOOLEAN := (D'ADDRESS IN MY_ADDRESS); + + TASK E IS + END E; + E1 : BOOLEAN := (E'ADDRESS IN MY_ADDRESS); + + TASK TYPE F IS + END F; + F1 : BOOLEAN := (F'ADDRESS IN MY_ADDRESS); + + G1 : BOOLEAN; + + PACKAGE BODY B IS + BEGIN + NULL; + END B; + + PROCEDURE C IS + BEGIN + NULL; + END C; + + FUNCTION D RETURN BOOLEAN IS + BEGIN + RETURN TRUE; + END D; + + TASK BODY E IS + BEGIN + NULL; + END E; + + TASK BODY F IS + BEGIN + NULL; + END F; + + BEGIN +<> G1 := (G'ADDRESS IN MY_ADDRESS); + END; + + RESULT; +END AD7201A; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7203b.ada b/gcc/testsuite/ada/acats/tests/a/ad7203b.ada new file mode 100644 index 000000000..47dd6b770 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7203b.ada @@ -0,0 +1,267 @@ +-- AD7203B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT THE PREFIX OF THE 'SIZE' ATTRIBUTE CAN BE AN OBJECT, +-- A TYPE, OR A SUBTYPE. + +-- HISTORY: +-- BCB 09/27/88 CREATED ORIGINAL TEST BY MODIFYING AND RENAMING +-- CD7203B.ADA. + +WITH SYSTEM; +WITH REPORT; USE REPORT; +PROCEDURE AD7203B IS + + TYPE I_REC IS + RECORD + I1, I2 : INTEGER; + END RECORD; + + I : INTEGER; + I_A : ARRAY (1 ..5) OF INTEGER; + I_R : I_REC; + + I_SIZE : INTEGER := I'SIZE; + I_A_SIZE : INTEGER := I_A'SIZE; + I_R_SIZE : INTEGER := I_R'SIZE; + I_A_1_SIZE : INTEGER := I_A(1)'SIZE; + I_R_I1_SIZE : INTEGER := I_R.I1'SIZE; + + TYPE FIXED IS DELTA 0.01 RANGE -1.0 .. 1.0; + TYPE FXD_REC IS + RECORD + FXD1, FXD2 : FIXED; + END RECORD; + + FXD : FIXED; + FXD_A : ARRAY (1 .. 5) OF FIXED; + FXD_R : FXD_REC; + + FXD_SIZE : INTEGER := FXD'SIZE; + FXD_A_SIZE : INTEGER := FXD_A'SIZE; + FXD_R_SIZE : INTEGER := FXD_R'SIZE; + FXD_A_1_SIZE : INTEGER := FXD_A(1)'SIZE; + FXD_R_FXD1_SIZE : INTEGER := FXD_R.FXD1'SIZE; + + TYPE FLT_REC IS + RECORD + FLT1, FLT2 : FLOAT; + END RECORD; + + FLT : FLOAT; + FLT_A : ARRAY (1 .. 5) OF FLOAT; + FLT_R : FLT_REC; + + FLT_SIZE : INTEGER := FLT'SIZE; + FLT_A_SIZE : INTEGER := FLT_A'SIZE; + FLT_R_SIZE : INTEGER := FLT_R'SIZE; + FLT_A_1_SIZE : INTEGER := FLT_A(1)'SIZE; + FLT_R_FLT1_SIZE : INTEGER := FLT_R.FLT1'SIZE; + + SUBTYPE TINY_INT IS INTEGER RANGE 0 .. 255; + TYPE TI_REC IS + RECORD + TI1, TI2 : TINY_INT; + END RECORD; + + TI : TINY_INT; + TI_A : ARRAY (1 .. 5) OF TINY_INT; + TI_R : TI_REC; + + TINY_INT_SIZE : INTEGER := TINY_INT'SIZE; + TI_SIZE : INTEGER := TI'SIZE; + TI_A_SIZE : INTEGER := TI_A'SIZE; + TI_R_SIZE : INTEGER := TI_R'SIZE; + TI_A_1_SIZE : INTEGER := TI_A(1)'SIZE; + TI_R_TI1_SIZE : INTEGER := TI_R.TI1'SIZE; + + TYPE STR IS ARRAY (TINY_INT RANGE <>) OF CHARACTER; + TYPE STR_2 IS ARRAY (1 .. 127) OF CHARACTER; + TYPE STR_REC IS + RECORD + S1, S2 : STR (TINY_INT'FIRST .. TINY_INT'LAST); + END RECORD; + + S : STR (TINY_INT'FIRST .. TINY_INT'LAST); + S_A : ARRAY (1 .. 5) OF STR (TINY_INT'FIRST .. TINY_INT'LAST); + S_R : STR_REC; + + STR_2_SIZE : INTEGER := STR_2'SIZE; + S_SIZE : INTEGER := S'SIZE; + S_A_SIZE : INTEGER := S_A'SIZE; + S_R_SIZE : INTEGER := S_R'SIZE; + S_A_1_SIZE : INTEGER := S_A(1)'SIZE; + S_R_S1_SIZE : INTEGER := S_R.S1'SIZE; + + TYPE C_REC IS + RECORD + C1, C2 : CHARACTER; + END RECORD; + + C : CHARACTER; + C_A : ARRAY (1 .. 5) OF CHARACTER; + C_R : C_REC; + + C_SIZE : INTEGER := C'SIZE; + C_A_SIZE : INTEGER := C_A'SIZE; + C_R_SIZE : INTEGER := C_R'SIZE; + C_A_1_SIZE : INTEGER := C_A(1)'SIZE; + C_R_C1_SIZE : INTEGER := C_R.C1'SIZE; + + TYPE B_REC IS + RECORD + B1, B2 : BOOLEAN; + END RECORD; + + B : BOOLEAN; + B_A : ARRAY (1 .. 5) OF BOOLEAN; + B_R : B_REC; + + B_SIZE : INTEGER := B'SIZE; + B_A_SIZE : INTEGER := B_A'SIZE; + B_R_SIZE : INTEGER := B_R'SIZE; + B_A_1_SIZE : INTEGER := B_A(1)'SIZE; + B_R_B1_SIZE : INTEGER := B_R.B1'SIZE; + + TYPE DISCR IS RANGE 1 .. 2; + TYPE DISCR_REC (D : DISCR := 1) IS + RECORD + CASE D IS + WHEN 1 => + C1_I : INTEGER; + WHEN 2 => + C2_I1 : INTEGER; + C2_I2 : INTEGER; + END CASE; + END RECORD; + + DR_UC : DISCR_REC; + DR_C : DISCR_REC (2); + DR_A : ARRAY (1 .. 5) OF DISCR_REC; + + DR_UC_SIZE : INTEGER := DR_UC'SIZE; + DR_C_SIZE : INTEGER := DR_C'SIZE; + DR_A_SIZE : INTEGER := DR_A'SIZE; + DR_UC_C1_I_SIZE : INTEGER := DR_UC.C1_I'SIZE; + DR_A_1_SIZE : INTEGER := DR_A(1)'SIZE; + + TYPE ENUM IS (E1, E2, E3, E4); + TYPE ENUM_REC IS + RECORD + E1, E2 : ENUM; + END RECORD; + + E : ENUM; + E_A : ARRAY (1 .. 5) OF ENUM; + E_R : ENUM_REC; + + E_SIZE : INTEGER := E'SIZE; + E_A_SIZE : INTEGER := E_A'SIZE; + E_R_SIZE : INTEGER := E_R'SIZE; + E_A_1_SIZE : INTEGER := E_A(1)'SIZE; + E_R_E1_SIZE : INTEGER := E_R.E1'SIZE; + + TASK TYPE TSK IS END TSK; + TYPE TSK_REC IS + RECORD + TSK1, TSK2 : TSK; + END RECORD; + + T : TSK; + T_A : ARRAY (1 .. 5) OF TSK; + T_R : TSK_REC; + + T_SIZE : INTEGER := T'SIZE; + T_A_SIZE : INTEGER := T_A'SIZE; + T_R_SIZE : INTEGER := T_R'SIZE; + T_A_1_SIZE : INTEGER := T_A(1)'SIZE; + T_R_TSK1_SIZE : INTEGER := T_R.TSK1'SIZE; + + TYPE ACC IS ACCESS INTEGER; + TYPE ACC_REC IS + RECORD + A1, A2 : ACC; + END RECORD; + + A : ACC; + A_A : ARRAY (1 .. 5) OF ACC; + A_R : ACC_REC; + + A_SIZE : INTEGER := A'SIZE; + A_A_SIZE : INTEGER := A_A'SIZE; + A_R_SIZE : INTEGER := A_R'SIZE; + A_A_1_SIZE : INTEGER := A_A(1)'SIZE; + A_R_A1_SIZE : INTEGER := A_R.A1'SIZE; + + PACKAGE PK IS + TYPE PRV IS PRIVATE; + TYPE PRV_REC IS + RECORD + P1, P2 : PRV; + END RECORD; + + TYPE LPRV IS LIMITED PRIVATE; + TYPE LPRV_REC IS + RECORD + LP1, LP2 : LPRV; + END RECORD; + PRIVATE + TYPE PRV IS NEW INTEGER; + + TYPE LPRV IS NEW INTEGER; + END PK; + USE PK; + + P : PRV; + P_A : ARRAY (1 .. 5) OF PRV; + P_R : PRV_REC; + + P_SIZE : INTEGER := P'SIZE; + P_A_SIZE : INTEGER := P_A'SIZE; + P_R_SIZE : INTEGER := P_R'SIZE; + P_A_1_SIZE : INTEGER := P_A(1)'SIZE; + P_R_P1_SIZE : INTEGER := P_R.P1'SIZE; + + LP : LPRV; + LP_A : ARRAY (1 .. 5) OF LPRV; + LP_R : LPRV_REC; + + LP_SIZE : INTEGER := LP'SIZE; + LP_A_SIZE : INTEGER := LP_A'SIZE; + LP_R_SIZE : INTEGER := LP_R'SIZE; + LP_A_1_SIZE : INTEGER := LP_A(1)'SIZE; + LP_R_LP1_SIZE : INTEGER := LP_R.LP1'SIZE; + + TASK BODY TSK IS + BEGIN + NULL; + END TSK; + +BEGIN + TEST ("AD7203B", "CHECK THAT THE PREFIX OF THE 'SIZE' ATTRIBUTE " & + "CAN BE AN OBJECT, A TYPE, OR A SUBTYPE"); + + RESULT; +END AD7203B; diff --git a/gcc/testsuite/ada/acats/tests/a/ad7205b.ada b/gcc/testsuite/ada/acats/tests/a/ad7205b.ada new file mode 100644 index 000000000..d619750d3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad7205b.ada @@ -0,0 +1,64 @@ +-- AD7205B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT THE PREFIX OF THE 'STORAGE_SIZE ATTRIBUTE CAN BE AN +-- ACCESS TYPE, A TASK TYPE, A TASK OBJECT, OR A SINGLE TASK. + +-- HISTORY: +-- JET 09/22/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +PROCEDURE AD7205B IS + + B : BOOLEAN; + + TYPE A IS ACCESS INTEGER; + TASK TYPE T; + T1 : T; + TASK T2; + + TASK BODY T IS + BEGIN + NULL; + END T; + + TASK BODY T2 IS + BEGIN + NULL; + END T2; + +BEGIN + + TEST ("AD7205B", "CHECK THAT THE PREFIX OF THE 'STORAGE_SIZE " & + "ATTRIBUTE CAN BE AN ACCESS TYPE, A TASK TYPE, " & + "A TASK OBJECT, OR A SINGLE TASK"); + + B := A'STORAGE_SIZE = T'STORAGE_SIZE; -- ACCESS AND TASK TYPES. + B := T1'STORAGE_SIZE = T2'STORAGE_SIZE; -- TASK OBJECT & SINGLE + -- TASK. + + RESULT; + +END AD7205B; diff --git a/gcc/testsuite/ada/acats/tests/a/ad8011a.tst b/gcc/testsuite/ada/acats/tests/a/ad8011a.tst new file mode 100644 index 000000000..93f666c3c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ad8011a.tst @@ -0,0 +1,64 @@ +-- AD8011A.TST + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT CODE STATEMENTS ARE ALLOWED IN A PROCEDURE BODY. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT +-- MACHINE CODE INSERTIONS. + +-- IF SUCH INSERTIONS ARE NOT SUPPORTED, THE "WITH MACHINE_CODE" +-- CLAUSE MUST BE REJECTED. + + +-- MACRO SUBSTITUTION: +-- IF MACHINE CODE INSERTIONS ARE SUPPORTED THEN THE MACRO +-- $MACHINE_CODE_STATEMENT MUST BE REPLACED BY A VALID CODE +-- STATEMENT. + +-- IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED, THEN SUBSTITUTE +-- THE ADA NULL STATEMENT (IE: NULL;) FOR $MACHINE_CODE_STATEMENT. + +-- HISTORY: +-- DHH 08/30/88 CREATED ORIGINAL TEST. + +WITH MACHINE_CODE; -- N/A => ERROR. +USE MACHINE_CODE; +WITH REPORT; USE REPORT; +PROCEDURE AD8011A IS + + PROCEDURE CODE IS + BEGIN + $MACHINE_CODE_STATEMENT + END; + +BEGIN + TEST("AD8011A", "CHECK THAT CODE STATEMENTS ARE ALLOWED IN " & + "A PROCEDURE BODY"); + + CODE; + + RESULT; +END AD8011A; diff --git a/gcc/testsuite/ada/acats/tests/a/ada101a.ada b/gcc/testsuite/ada/acats/tests/a/ada101a.ada new file mode 100644 index 000000000..84b69d9b3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ada101a.ada @@ -0,0 +1,101 @@ +-- ADA101A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT UNCHECKED_DEALLOCATION CAN BE INSTANTIATED WITH ANY +-- TYPE AS THE OBJECT PARAMETER. + +-- HISTORY: +-- JET 09/23/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH UNCHECKED_DEALLOCATION; +PROCEDURE ADA101A IS + + TYPE ENUM IS (CURLY, MOE, LARRY); + TYPE DER IS NEW INTEGER; + SUBTYPE SUB IS CHARACTER RANGE 'A'..'Z'; + TASK TYPE TSK; + TYPE ACC IS ACCESS INTEGER; + + PACKAGE P IS + TYPE PRIV IS PRIVATE; + PRIVATE + TYPE PRIV IS RANGE -100..100; + END P; + USE P; + + TYPE ARR1 IS ARRAY (INTEGER RANGE 1..10) OF INTEGER; + TYPE ARR2 IS ARRAY (INTEGER RANGE <>) OF CHARACTER; + + TYPE REC1 IS RECORD + D, I : INTEGER; + END RECORD; + + TYPE REC2 (D : INTEGER) IS RECORD + C : CHARACTER; + END RECORD; + + TYPE INTEGERA IS ACCESS INTEGER; + TYPE FLOATA IS ACCESS FLOAT; + TYPE ENUMA IS ACCESS ENUM; + TYPE BOOLEANA IS ACCESS BOOLEAN; + TYPE CHARACTERA IS ACCESS CHARACTER; + TYPE DERA IS ACCESS DER; + TYPE SUBA IS ACCESS SUB; + TYPE TSKA IS ACCESS TSK; + TYPE ACCA IS ACCESS ACC; + TYPE PRIVA IS ACCESS PRIV; + TYPE ARR1A IS ACCESS ARR1; + TYPE ARR2A IS ACCESS ARR2; + TYPE REC1A IS ACCESS REC1; + TYPE REC2A IS ACCESS REC2; + + TASK BODY TSK IS + BEGIN + NULL; + END TSK; + + PROCEDURE RLSI IS NEW UNCHECKED_DEALLOCATION(INTEGER, INTEGERA); + PROCEDURE RLSF IS NEW UNCHECKED_DEALLOCATION(FLOAT, FLOATA); + PROCEDURE RLSE IS NEW UNCHECKED_DEALLOCATION(ENUM, ENUMA); + PROCEDURE RLSB IS NEW UNCHECKED_DEALLOCATION(BOOLEAN, BOOLEANA); + PROCEDURE RLSC IS NEW UNCHECKED_DEALLOCATION(CHARACTER,CHARACTERA); + PROCEDURE RLSD IS NEW UNCHECKED_DEALLOCATION(DER, DERA); + PROCEDURE RLSS IS NEW UNCHECKED_DEALLOCATION(SUB, SUBA); + PROCEDURE RLST IS NEW UNCHECKED_DEALLOCATION(TSK, TSKA); + PROCEDURE RLSA IS NEW UNCHECKED_DEALLOCATION(ACC, ACCA); + PROCEDURE RLSP IS NEW UNCHECKED_DEALLOCATION(PRIV, PRIVA); + PROCEDURE RLSA1 IS NEW UNCHECKED_DEALLOCATION(ARR1, ARR1A); + PROCEDURE RLSA2 IS NEW UNCHECKED_DEALLOCATION(ARR2, ARR2A); + PROCEDURE RLSR1 IS NEW UNCHECKED_DEALLOCATION(REC1, REC1A); + PROCEDURE RLSR2 IS NEW UNCHECKED_DEALLOCATION(REC2, REC2A); + +BEGIN + TEST ("ADA101A", "CHECK THAT UNCHECKED_DEALLOCATION CAN BE " & + "INSTANTIATED WITH ANY TYPE AS THE OBJECT " & + "PARAMETER"); + + RESULT; +END ADA101A; diff --git a/gcc/testsuite/ada/acats/tests/a/ae2113a.ada b/gcc/testsuite/ada/acats/tests/a/ae2113a.ada new file mode 100644 index 000000000..4630d39c7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ae2113a.ada @@ -0,0 +1,120 @@ +-- AE2113A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT THE SUBPROGRAMS CREATE, OPEN, CLOSE, DELETE, RESET, MODE, +-- NAME, FORM, AND IS_OPEN ARE AVAILABLE FOR DIRECT_IO AND THAT +-- SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER NAMES. + +-- TBN 9/30/86 + +WITH DIRECT_IO; +WITH REPORT; USE REPORT; +PROCEDURE AE2113A IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + + TEMP : FILE_TYPE; + +BEGIN + TEST ("AE2113A", "CHECK THAT THE SUBPROGRAMS CREATE, OPEN, " & + "CLOSE, DELETE, RESET, MODE, NAME, FORM, AND " & + "IS_OPEN ARE AVAILABLE FOR DIRECT_IO AND THAT " & + "SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER " & + "NAMES"); + BEGIN + CREATE (FILE=> TEMP, MODE=> OUT_FILE, + NAME=> "AE2113A.DAT", FORM=> ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + RESET (FILE=> TEMP, MODE=> OUT_FILE); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + CLOSE (FILE=> TEMP); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + OPEN (FILE=> TEMP, MODE=> OUT_FILE, + NAME=> "AE2113A.DAT", FORM=> ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF IS_OPEN (FILE=> TEMP) THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF MODE (FILE=> TEMP) /= OUT_FILE THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF NAME (FILE=> TEMP) /= "AE2113A.DAT" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF FORM (FILE=> TEMP) /= "" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + DELETE (FILE=> TEMP); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + RESULT; +END AE2113A; diff --git a/gcc/testsuite/ada/acats/tests/a/ae2113b.ada b/gcc/testsuite/ada/acats/tests/a/ae2113b.ada new file mode 100644 index 000000000..969813179 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ae2113b.ada @@ -0,0 +1,120 @@ +-- AE2113B.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT THE SUBPROGRAMS CREATE, OPEN, CLOSE, DELETE, RESET, MODE, +-- NAME, FORM, AND IS_OPEN ARE AVAILABLE FOR SEQUENTIAL_IO AND THAT +-- SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER NAMES. + +-- TBN 9/30/86 + +WITH SEQUENTIAL_IO; +WITH REPORT; USE REPORT; +PROCEDURE AE2113B IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + + TEMP : FILE_TYPE; + +BEGIN + TEST ("AE2113B", "CHECK THAT THE SUBPROGRAMS CREATE, OPEN, " & + "CLOSE, DELETE, RESET, MODE, NAME, FORM, AND " & + "IS_OPEN ARE AVAILABLE FOR SEQUENTIAL_IO AND " & + "THAT SUBPROGRAMS HAVE THE CORRECT FORMAL " & + "PARAMETER NAMES"); + BEGIN + CREATE (FILE=> TEMP, MODE=> OUT_FILE, + NAME=> "AE2113B.DAT", FORM=> ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + RESET (FILE=> TEMP, MODE=> OUT_FILE); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + CLOSE (FILE=> TEMP); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + OPEN (FILE=> TEMP, MODE=> OUT_FILE, + NAME=> "AE2113B.DAT", FORM=> ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF IS_OPEN (FILE=> TEMP) THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF MODE (FILE=> TEMP) /= OUT_FILE THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF NAME (FILE=> TEMP) /= "AE2113B.DAT" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF FORM (FILE=> TEMP) /= "" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + DELETE (FILE=> TEMP); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + RESULT; +END AE2113B; diff --git a/gcc/testsuite/ada/acats/tests/a/ae3002g.ada b/gcc/testsuite/ada/acats/tests/a/ae3002g.ada new file mode 100644 index 000000000..0a110cf14 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ae3002g.ada @@ -0,0 +1,47 @@ +-- AE3002G.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT FILE_MODE IS VISIBLE AND HAS LITERALS IN_FILE AND +-- OUT_FILE. ASLO CHECK THAT TYPE_SET IS VISIBLE AND HAS LITERALS +-- LOWER_CASE AND UPPER_CASE. + +-- TBN 10/3/86 + +WITH TEXT_IO; USE TEXT_IO; +WITH REPORT; USE REPORT; +PROCEDURE AE3002G IS + + TEMP_FILE : FILE_TYPE; + MODE : FILE_MODE := IN_FILE; + LETTERS : TYPE_SET := LOWER_CASE; + +BEGIN + TEST ("AE3002G", "CHECK THAT FILE_MODE AND TYPE_SET ARE VISIBLE " & + "AND CHECK THEIR LITERALS"); + + MODE := OUT_FILE; + LETTERS := UPPER_CASE; + + RESULT; +END AE3002G; diff --git a/gcc/testsuite/ada/acats/tests/a/ae3101a.ada b/gcc/testsuite/ada/acats/tests/a/ae3101a.ada new file mode 100644 index 000000000..d050ee0e9 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ae3101a.ada @@ -0,0 +1,135 @@ +-- AE3101A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- OBJECTIVE: +-- CHECK THAT CREATE, OPEN, CLOSE, DELETE, RESET, MODE, NAME, +-- FORM, IS_OPEN, AND END_OF_FILE ARE AVAILABLE FOR TEXT FILES. +-- ALSO CHECK THAT FORMAL PARAMETER NAMES ARE CORRECT. + +-- HISTORY: +-- ABW 08/24/82 +-- SPS 09/16/82 +-- SPS 11/09/82 +-- DWC 09/24/87 REMOVED DEPENDENCE ON FILE SUPPORT. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE AE3101A IS + + FILE1 : FILE_TYPE; + +BEGIN + + TEST ("AE3101A" , "CHECK THAT CREATE, OPEN, DELETE, " & + "RESET, MODE, NAME, FORM, IS_OPEN, " & + "AND END_OF_FILE ARE AVAILABLE " & + "FOR TEXT FILE"); + + BEGIN + CREATE (FILE => FILE1, + MODE => OUT_FILE, + NAME => LEGAL_FILE_NAME, + FORM => ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + RESET (FILE => FILE1, MODE => IN_FILE); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + CLOSE (FILE => FILE1); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + OPEN (FILE => FILE1, + MODE => IN_FILE, + NAME => LEGAL_FILE_NAME, + FORM => ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + IF IS_OPEN (FILE => FILE1) THEN + NULL; + END IF; + + BEGIN + IF MODE (FILE => FILE1) /= IN_FILE THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF NAME (FILE => FILE1) /= LEGAL_FILE_NAME THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF FORM (FILE => FILE1) /= "" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF END_OF_FILE (FILE => FILE1) THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + DELETE (FILE => FILE1); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + RESULT; + +END AE3101A; diff --git a/gcc/testsuite/ada/acats/tests/a/ae3702a.ada b/gcc/testsuite/ada/acats/tests/a/ae3702a.ada new file mode 100644 index 000000000..a18b1a003 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ae3702a.ada @@ -0,0 +1,59 @@ +-- AE3702A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THAT INTEGER_IO CAN BE INSTANTIATED FOR USER DEFINED INTEGER +-- TYPES. + +-- SPS 10/1/82 + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE AE3702A IS +BEGIN + + TEST ("AE3702A", "CHECK THAT INTEGER_IO CAN BE INSTANTIATED FOR " & + "USER DEFINED TYPES"); + + DECLARE + TYPE I1 IS RANGE 6 .. 14; + TYPE I2 IS NEW INTEGER; + TYPE I3 IS NEW INTEGER RANGE 0 .. INTEGER'LAST; + SUBTYPE S1 IS INTEGER RANGE 6 .. 14; + SUBTYPE S2 IS INTEGER; + SUBTYPE S3 IS INTEGER RANGE 0 .. INTEGER'LAST; + + PACKAGE NIO1 IS NEW INTEGER_IO (I1); + PACKAGE NIO2 IS NEW INTEGER_IO (I2); + PACKAGE NIO3 IS NEW INTEGER_IO (I3); + PACKAGE NIO4 IS NEW INTEGER_IO (S1); + PACKAGE NIO5 IS NEW INTEGER_IO (S2); + PACKAGE NIO6 IS NEW INTEGER_IO (S3); + + BEGIN + NULL; + END; + + RESULT; +END AE3702A; diff --git a/gcc/testsuite/ada/acats/tests/a/ae3709a.ada b/gcc/testsuite/ada/acats/tests/a/ae3709a.ada new file mode 100644 index 000000000..5866120b0 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/a/ae3709a.ada @@ -0,0 +1,56 @@ +-- AE3709A.ADA + +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- CHECK THE NAMES OF THE FORMAL PARAMETERS. + +-- JBG 3/30/83 + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE AE3709A IS + + PACKAGE INT IS NEW INTEGER_IO(INTEGER); + USE INT; + FILE : FILE_TYPE; + STR : STRING(1..3); + LAST : POSITIVE; + ITEM : INTEGER; + +BEGIN + + TEST ("AE3709A", "CHECK NAMES OF FORMAL PARAMETERS"); + + IF EQUAL(2, 3) THEN + GET (FILE => FILE, ITEM => ITEM, WIDTH => 0); + GET (ITEM => ITEM, WIDTH => 0); + PUT (FILE => FILE, ITEM => ITEM, WIDTH => 4, BASE => 4); + PUT (ITEM => ITEM, WIDTH => 4, BASE => 4); + GET (FROM => STR, ITEM => ITEM, LAST => LAST); + PUT (TO => STR, ITEM => ITEM, BASE => 4); + END IF; + + RESULT; + +END AE3709A; -- cgit v1.2.3