1-- C83033A.ADA
2
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25-- OBJECTIVE:
26--     CHECK THAT AN IMPLICIT DECLARATION OF A BLOCK NAME, A LOOP NAME,
27--     OR A STATEMENT LABEL HIDES THE DECLARATION OF AN ENUMERATION
28--     LITERAL OR OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED TYPE
29--     DEFINITION.
30
31-- HISTORY:
32--     DHH 09/21/88  CREATED ORIGINAL TEST.
33--     WMC 03/25/92  REMOVED TEST REDUNDANCIES.
34
35
36WITH REPORT; USE REPORT;
37PROCEDURE C83033A IS
38
39     PACKAGE BASE_P IS
40          TYPE A IS (RED, BLUE, YELO);
41          FUNCTION RED(T : INTEGER; X : A) RETURN A;
42          FUNCTION BLUE(T : INTEGER; X : A) RETURN A;
43     END BASE_P;
44
45     PACKAGE BODY BASE_P IS
46          FUNCTION RED(T : INTEGER; X : A) RETURN A IS
47          BEGIN
48               IF EQUAL(T, T) THEN
49                    RETURN X;
50               ELSE
51                    RETURN YELO;
52               END IF;
53          END RED;
54
55          FUNCTION BLUE(T : INTEGER; X : A) RETURN A IS
56          BEGIN
57               IF EQUAL(T, T) THEN
58                    RETURN X;
59               ELSE
60                    RETURN YELO;
61               END IF;
62          END BLUE;
63
64     END BASE_P;
65BEGIN
66     TEST ("C83033A", "CHECK THAT AN IMPLICIT DECLARATION OF A BLOCK " &
67                      "NAME, A LOOP NAME, OR A STATEMENT LABEL HIDES " &
68                      "THE DECLARATION OF AN ENUMERATION LITERAL OR " &
69                      "OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED " &
70                      "TYPE DEFINITION");
71
72     B1:
73     DECLARE
74          TYPE STMT2 IS NEW BASE_P.A;
75     BEGIN
76
77          DECLARE
78               C, D : STMT2;
79          BEGIN
80               C := C83033A.B1.RED(3, C83033A.B1.RED);
81               D := C83033A.B1.RED;
82
83               GOTO RED;              -- DEMONSTRATES USE OF STATEMENT LABEL.
84               FAILED("STATEMENT LABEL - 1");
85
86     <<RED>>   IF C /= D THEN
87                  FAILED("STATEMENT LABEL - 2");
88               END IF;
89          END;
90     END B1;
91
92     B2:
93     DECLARE
94          TYPE STMT2 IS NEW BASE_P.A;
95     BEGIN
96
97          DECLARE
98               A : STMT2 := BLUE;
99               B : STMT2 := BLUE(3, BLUE);
100          BEGIN
101
102               BLUE:
103               FOR I IN 1 .. 1 LOOP
104                    IF A /= B THEN
105                         FAILED("LOOP NAME - 1");
106                    END IF;
107                    EXIT BLUE;                -- DEMONSTRATES USE OF LOOP LABEL.
108                    FAILED("LOOP NAME - 2");
109               END LOOP BLUE;
110          END;
111     END B2;
112
113     B4:
114     DECLARE
115          PACKAGE P IS
116               GLOBAL : INTEGER := 1;
117               TYPE ENUM IS (GREEN, BLUE);
118               TYPE PRIV IS PRIVATE;
119               FUNCTION GREEN RETURN PRIV;
120          PRIVATE
121               TYPE PRIV IS NEW ENUM;
122          END P;
123
124          PACKAGE BODY P IS
125               FUNCTION GREEN RETURN PRIV IS
126               BEGIN
127                    GLOBAL := GLOBAL + 1;
128                    RETURN BLUE;
129               END GREEN;
130          BEGIN
131               NULL;
132          END P;
133          USE P;
134     BEGIN
135          GREEN:
136          DECLARE
137               COLOR : PRIV := C83033A.B4.P.GREEN;
138          BEGIN
139               IF GREEN.COLOR /= C83033A.B4.P.GREEN OR ELSE GLOBAL /= 3 THEN
140                  FAILED("BLOCK NAME");
141               END IF;
142          END GREEN;
143     END B4;
144
145     RESULT;
146END C83033A;
147