summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c5/c51004a.ada
blob: 75fa271d0e56b2d3f3f0f8bb2a273380044fc384 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
-- C51004A.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 LABELS, LOOP IDENTIFIERS, AND BLOCK IDENTIFIERS ARE
-- IMPLICITLY DECLARED AT THE END OF THE DECLARATIVE PART.  PRIOR TO
-- THE END OF THE DECLARATIVE PART, THEY MAY BE USED TO REFERENCE
-- ENTITIES IN AN ENCLOSING SCOPE.  SUBTESTS ARE:
--        (A) BLOCK.
--        (B) PROCEDURE BODY.
--        (C) PACKAGE BODY.
--        (D) GENERIC FUNCTION BODY.
--        (E) GENERIC PACKAGE BODY.
--        (F) TASK BODY.

-- CPP  6/1/84

WITH REPORT;  USE REPORT;
PROCEDURE C51004A IS

BEGIN
     TEST("C51004A", "CHECK THAT LABELS, LOOP IDENTIFIERS, AND BLOCK " &
          "IDENTIFIERS MAY BE USED PRIOR TO THEIR IMPLICIT " &
          "DECLARATION");

OUTER: DECLARE

          TYPE IDN1 IS NEW INTEGER;
          IDN2 : CONSTANT INTEGER := 2;
          TYPE IDN3 IS ACCESS INTEGER;

     BEGIN     -- OUTER

     -----------------------------------------------

     A :  DECLARE

               A1 : IDN1;
               A2 : CONSTANT INTEGER := IDN2;
               A3 : IDN3;

               TEMP : INTEGER;

          BEGIN     -- A

           <<IDN1>> TEMP := 0;

             IDN2 : FOR I IN 1..1 LOOP
                         TEMP := A2;
                    END LOOP IDN2;

             IDN3 : BEGIN
                         NULL;
                    END IDN3;

          END A;

     -----------------------------------------------

     B :  DECLARE

               PROCEDURE P (TEMP : OUT INTEGER) IS

                    B1 : IDN1;
                    B2 : CONSTANT INTEGER := IDN2 + 2;
                    B3 : IDN3;

               BEGIN     -- P
               
          <<L>> <<IDN1>> TEMP := 0;

                  IDN2 : WHILE B2 < 0 LOOP
                              TEMP := 0;
                         END LOOP IDN2;

                  IDN3 : DECLARE
                         BEGIN
                              NULL;
                         END IDN3;

               END P;

          BEGIN     -- B
               NULL;
          END B;

     -----------------------------------------------

     C :  DECLARE

               PACKAGE PKG IS
               END PKG;

               PACKAGE BODY PKG IS

                    C1 : IDN1;
                    C2 : CONSTANT INTEGER := 2 * IDN2;
                    C3 : IDN3;

                    TEMP : INTEGER;

               BEGIN

                <<IDN1>> TEMP := 0;

                  IDN2 : LOOP
                              TEMP := 0;
                              EXIT;          
                         END LOOP IDN2;

                  IDN3 : BEGIN
                              NULL;
                         END IDN3;

               END PKG;

          BEGIN     -- C
               NULL;
          END C;

     ---------------------------------------------------

     D :  DECLARE

               GENERIC
                    TYPE Q IS (<>);
               FUNCTION FN RETURN INTEGER;

               FUNCTION FN RETURN INTEGER IS

                    D1 : IDN1;
                    D2 : CONSTANT INTEGER := IDN2;
                    D3 : IDN3;

                    TEMP : INTEGER;

               BEGIN     

                <<IDN1>> TEMP := 0;

                  IDN2 : FOR I IN 1..5 LOOP
                              TEMP := 0;
                         END LOOP IDN2;

                  IDN3 : BEGIN
                              NULL;
                         END IDN3;  
                    
                         RETURN TEMP;

               END FN;

          BEGIN
               NULL;
          END D;

     -----------------------------------------------

     E :  DECLARE

               GENERIC

                    TYPE ELEMENT IS (<>);
                    ITEM : ELEMENT;

               PACKAGE PKG IS
               END PKG;

               PACKAGE BODY PKG IS

                    E1 : IDN1 RANGE 1..5;
                    E2 : CONSTANT INTEGER := IDN2;
                    E3 : IDN3;

                    TEMP : ELEMENT;

               BEGIN

          <<IDN1>> <<L>> TEMP := ITEM;

                  IDN2 : WHILE TEMP /= ITEM LOOP
                              TEMP := ITEM;
                         END LOOP IDN2;

                  IDN3 : DECLARE
                         BEGIN
                              NULL;
                         END IDN3;

               END PKG;
          
          BEGIN     -- E

               DECLARE
                    PACKAGE P1 IS NEW PKG (INTEGER, 0);
               BEGIN
                    NULL;
               END;
               
          END E;

     -----------------------------------------------

     F :  DECLARE

               TASK T;

               TASK BODY T IS

                    F1 : IDN1 RANGE -4..2;
                    F2 : CONSTANT INTEGER := IDN2;
                    F3 : IDN3;

                    TEMP : INTEGER;

               BEGIN

                <<IDN1>> TEMP := 1;

                  IDN2 : LOOP
                              TEMP := TEMP + 1;
                              EXIT;
                         END LOOP IDN2;

                  IDN3 : DECLARE
                         BEGIN
                              TEMP := TEMP + 1;
                         END IDN3;

               END T;

          BEGIN     -- F
               NULL;
          END F;

     -----------------------------------------------

     END OUTER;

     RESULT;
END C51004A;