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/c8/c83033a.ada | 146 +++++++++++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/c8/c83033a.ada (limited to 'gcc/testsuite/ada/acats/tests/c8/c83033a.ada') diff --git a/gcc/testsuite/ada/acats/tests/c8/c83033a.ada b/gcc/testsuite/ada/acats/tests/c8/c83033a.ada new file mode 100644 index 000000000..6cfca9326 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c8/c83033a.ada @@ -0,0 +1,146 @@ +-- C83033A.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 IMPLICIT DECLARATION OF A BLOCK NAME, A LOOP NAME, +-- OR A STATEMENT LABEL HIDES THE DECLARATION OF AN ENUMERATION +-- LITERAL OR OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED TYPE +-- DEFINITION. + +-- HISTORY: +-- DHH 09/21/88 CREATED ORIGINAL TEST. +-- WMC 03/25/92 REMOVED TEST REDUNDANCIES. + + +WITH REPORT; USE REPORT; +PROCEDURE C83033A IS + + PACKAGE BASE_P IS + TYPE A IS (RED, BLUE, YELO); + FUNCTION RED(T : INTEGER; X : A) RETURN A; + FUNCTION BLUE(T : INTEGER; X : A) RETURN A; + END BASE_P; + + PACKAGE BODY BASE_P IS + FUNCTION RED(T : INTEGER; X : A) RETURN A IS + BEGIN + IF EQUAL(T, T) THEN + RETURN X; + ELSE + RETURN YELO; + END IF; + END RED; + + FUNCTION BLUE(T : INTEGER; X : A) RETURN A IS + BEGIN + IF EQUAL(T, T) THEN + RETURN X; + ELSE + RETURN YELO; + END IF; + END BLUE; + + END BASE_P; +BEGIN + TEST ("C83033A", "CHECK THAT AN IMPLICIT DECLARATION OF A BLOCK " & + "NAME, A LOOP NAME, OR A STATEMENT LABEL HIDES " & + "THE DECLARATION OF AN ENUMERATION LITERAL OR " & + "OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED " & + "TYPE DEFINITION"); + + B1: + DECLARE + TYPE STMT2 IS NEW BASE_P.A; + BEGIN + + DECLARE + C, D : STMT2; + BEGIN + C := C83033A.B1.RED(3, C83033A.B1.RED); + D := C83033A.B1.RED; + + GOTO RED; -- DEMONSTRATES USE OF STATEMENT LABEL. + FAILED("STATEMENT LABEL - 1"); + + <> IF C /= D THEN + FAILED("STATEMENT LABEL - 2"); + END IF; + END; + END B1; + + B2: + DECLARE + TYPE STMT2 IS NEW BASE_P.A; + BEGIN + + DECLARE + A : STMT2 := BLUE; + B : STMT2 := BLUE(3, BLUE); + BEGIN + + BLUE: + FOR I IN 1 .. 1 LOOP + IF A /= B THEN + FAILED("LOOP NAME - 1"); + END IF; + EXIT BLUE; -- DEMONSTRATES USE OF LOOP LABEL. + FAILED("LOOP NAME - 2"); + END LOOP BLUE; + END; + END B2; + + B4: + DECLARE + PACKAGE P IS + GLOBAL : INTEGER := 1; + TYPE ENUM IS (GREEN, BLUE); + TYPE PRIV IS PRIVATE; + FUNCTION GREEN RETURN PRIV; + PRIVATE + TYPE PRIV IS NEW ENUM; + END P; + + PACKAGE BODY P IS + FUNCTION GREEN RETURN PRIV IS + BEGIN + GLOBAL := GLOBAL + 1; + RETURN BLUE; + END GREEN; + BEGIN + NULL; + END P; + USE P; + BEGIN + GREEN: + DECLARE + COLOR : PRIV := C83033A.B4.P.GREEN; + BEGIN + IF GREEN.COLOR /= C83033A.B4.P.GREEN OR ELSE GLOBAL /= 3 THEN + FAILED("BLOCK NAME"); + END IF; + END GREEN; + END B4; + + RESULT; +END C83033A; -- cgit v1.2.3