Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c8/c83051a.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C83051A.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 DECLARATIONS IN THE VISIBLE PART OF A PACKAGE NESTED
27 -- WITHIN THE VISIBLE PART OF A PACKAGE ARE VISIBLE BY SELECTION
28 -- FROM OUTSIDE THE OUTERMOST PACKAGE.
29
30 -- HISTORY:
31 -- GMT 09/07/88 CREATED ORIGINAL TEST.
32
33 WITH REPORT; USE REPORT;
34
35 PROCEDURE C83051A IS
36
37 BEGIN
38 TEST ("C83051A", "CHECK THAT DECLARATIONS IN THE VISIBLE " &
39 "PART OF A PACKAGE NESTED WITHIN THE VISIBLE " &
40 "PART OF A PACKAGE ARE VISIBLE BY SELECTION " &
41 "FROM OUTSIDE THE OUTERMOST PACKAGE");
42 A_BLOCK:
43 DECLARE
44 PACKAGE APACK IS
45 PACKAGE BPACK IS
46 TYPE T1 IS (RED,GREEN);
47 TYPE T2A IS ('A', 'B', 'C', 'D');
48 TYPE T3 IS NEW BOOLEAN;
49 TYPE T4 IS NEW INTEGER RANGE -3 .. 8;
50 TYPE T5 IS DIGITS 5;
51 TYPE T67 IS DELTA 0.5 RANGE -2.0 .. 10.0;
52 TYPE T9A IS ARRAY (INTEGER RANGE <>) OF T3;
53 SUBTYPE T9B IS T9A (1..10);
54 TYPE T9C IS ACCESS T9B;
55 TYPE T10 IS PRIVATE;
56 V1 : T3 := FALSE;
57 ZERO : CONSTANT T4 := 0;
58 A_FLT : T5 := 3.0;
59 A_FIX : T67 := -1.0;
60 ARY : T9A(1..4) := (TRUE,TRUE,TRUE,FALSE);
61 P1 : T9C := NEW T9B'( 1..5 => T3'(TRUE),
62 6..10 => T3'(FALSE) );
63 C1 : CONSTANT T10;
64
65 FUNCTION RET_T1 (X : T1) RETURN T1;
66
67 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
68
69 GENERIC
70 PROCEDURE DO_NOTHING (X : IN OUT T3);
71 PRIVATE
72 TYPE T10 IS NEW CHARACTER;
73 C1 : CONSTANT T10 := 'J';
74 END BPACK;
75 END APACK;
76
77 PACKAGE BODY APACK IS
78 PACKAGE BODY BPACK IS
79 FUNCTION RET_T1 (X : T1) RETURN T1 IS
80 BEGIN
81 IF X = RED THEN
82 RETURN GREEN;
83 ELSE
84 RETURN RED;
85 END IF;
86 END RET_T1;
87
88 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
89 BEGIN
90 RETURN T10(X);
91 END RET_CHAR;
92
93 PROCEDURE DO_NOTHING (X : IN OUT T3) IS
94 BEGIN
95 IF X = TRUE THEN
96 X := FALSE;
97 ELSE
98 X := TRUE;
99 END IF;
100 END DO_NOTHING;
101 END BPACK;
102 END APACK;
103
104 PROCEDURE NEW_DO_NOTHING IS NEW APACK.BPACK.DO_NOTHING;
105
106 BEGIN
107
108 -- A1: VISIBILITY FOR UNOVERLOADED ENUMERATION LITERALS
109
110 IF APACK.BPACK.">"(APACK.BPACK.RED, APACK.BPACK.GREEN) THEN
111 FAILED ("VISIBILITY FOR UNOVERLOADED ENUMERATION " &
112 "LITERAL BAD - A1");
113 END IF;
114
115
116 -- A2: VISIBILITY FOR OVERLOADED
117 -- ENUMERATION CHARACTER LITERALS
118
119 IF APACK.BPACK."<"(APACK.BPACK.T2A'(APACK.BPACK.'C'),
120 APACK.BPACK.T2A'(APACK.BPACK.'B')) THEN
121 FAILED ("VISIBILITY FOR OVERLOADED ENUMERATION " &
122 "LITERAL BAD - A2");
123 END IF;
124
125
126 -- A3: VISIBILITY FOR A DERIVED BOOLEAN TYPE
127
128 IF APACK.BPACK."<"(APACK.BPACK.T3'(APACK.BPACK.TRUE),
129 APACK.BPACK.FALSE) THEN
130 FAILED ("VISIBILITY FOR DERIVED BOOLEAN BAD - A3");
131 END IF;
132
133
134 -- A4: VISIBILITY FOR AN INTEGER TYPE
135
136 IF APACK.BPACK."/="(APACK.BPACK."MOD"(6,2),APACK.BPACK.ZERO)
137 THEN FAILED ("VISIBILITY FOR INTEGER TYPE BAD - A4");
138 END IF;
139
140
141 -- A5: VISIBILITY FOR A FLOATING POINT TYPE
142
143 IF APACK.BPACK.">"(APACK.BPACK.T5'(2.7),APACK.BPACK.A_FLT)
144 THEN FAILED ("VISIBILITY FOR FLOATING POINT BAD - A5");
145 END IF;
146
147
148 -- A6: VISIBILITY FOR A FIXED POINT INVOLVING UNARY MINUS
149
150 IF APACK.BPACK."<"(APACK.BPACK.A_FIX,APACK.BPACK.T67'
151 (APACK.BPACK."-"(1.5))) THEN
152 FAILED ("VISIBILITY FOR FIXED POINT WITH UNARY MINUS " &
153 "BAD - A6");
154 END IF;
155
156
157 -- A7: VISIBILITY FOR A FIXED POINT DIVIDED BY INTEGER
158
159 IF APACK.BPACK."/="(APACK.BPACK.T67(-0.5),APACK.BPACK."/"
160 (APACK.BPACK.A_FIX,2)) THEN
161 FAILED ("VISIBILITY FOR FIXED POINT DIVIDED BY " &
162 "INTEGER BAD - A7");
163 END IF;
164
165
166 -- A8: VISIBILITY FOR ARRAY EQUALITY
167
168 IF APACK.BPACK."/="(APACK.BPACK.ARY,(APACK.BPACK.T3(TRUE),
169 APACK.BPACK.T3(TRUE),APACK.BPACK.T3(TRUE),
170 APACK.BPACK.T3(FALSE))) THEN
171 FAILED ("VISIBILITY FOR ARRAY EQUALITY BAD - A8");
172 END IF;
173
174
175 -- A9: VISIBILITY FOR ACCESS EQUALITY
176
177 IF APACK.BPACK."/="(APACK.BPACK.P1(3),
178 APACK.BPACK.T3(IDENT_BOOL(TRUE)))
179 THEN FAILED ("VISIBILITY FOR ACCESS EQUALITY BAD - A9");
180 END IF;
181
182
183 -- A10: VISIBILITY FOR PRIVATE TYPE
184
185 IF APACK.BPACK."/="(APACK.BPACK.C1,
186 APACK.BPACK.RET_CHAR('J')) THEN
187 FAILED ("VISIBILITY FOR PRIVATE TYPE BAD - A10");
188 END IF;
189
190
191 -- A11: VISIBILITY FOR DERIVED SUBPROGRAM
192
193 IF APACK.BPACK."/="(APACK.BPACK.RET_T1(APACK.BPACK.RED),
194 APACK.BPACK.GREEN) THEN
195 FAILED ("VISIBILITY FOR DERIVED SUBPROGRAM BAD - A11");
196 END IF;
197
198 -- A12: VISIBILITY FOR GENERIC SUBPROGRAM
199
200 NEW_DO_NOTHING (APACK.BPACK.V1);
201
202 IF APACK.BPACK."/="(APACK.BPACK.V1,APACK.BPACK.T3(TRUE)) THEN
203 FAILED ("VISIBILITY FOR GENERIC SUBPROGRAM BAD - A12");
204 END IF;
205
206 END A_BLOCK;
207
208 B_BLOCK:
209 DECLARE
210 GENERIC
211 TYPE T1 IS (<>);
212 PACKAGE GENPACK IS
213 PACKAGE APACK IS
214 PACKAGE BPACK IS
215 TYPE T1 IS (ORANGE,GREEN);
216 TYPE T2A IS ('E', 'F', 'G');
217 TYPE T3 IS NEW BOOLEAN;
218 TYPE T4 IS NEW INTEGER RANGE -3 .. 8;
219 TYPE T5 IS DIGITS 5;
220 TYPE T67 IS DELTA 0.5 RANGE -3.0 .. 25.0;
221 TYPE T9A IS ARRAY (INTEGER RANGE <>) OF T3;
222 SUBTYPE T9B IS T9A (2 .. 8);
223 TYPE T9C IS ACCESS T9B;
224 TYPE T10 IS PRIVATE;
225 V1 : T3 := TRUE;
226 SIX : T4 := 6;
227 B_FLT : T5 := 4.0;
228 ARY : T9A(1..4) := (TRUE,FALSE,TRUE,FALSE);
229 P1 : T9C := NEW T9B'( 2..4 => T3'(FALSE),
230 5..8 => T3'(TRUE));
231 K1 : CONSTANT T10;
232
233 FUNCTION RET_T1 (X : T1) RETURN T1;
234
235 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
236
237 GENERIC
238 PROCEDURE DO_NOTHING (X : IN OUT T3);
239 PRIVATE
240 TYPE T10 IS NEW CHARACTER;
241 K1 : CONSTANT T10 := 'V';
242 END BPACK;
243 END APACK;
244 END GENPACK;
245
246 PACKAGE BODY GENPACK IS
247 PACKAGE BODY APACK IS
248 PACKAGE BODY BPACK IS
249 FUNCTION RET_T1 (X : T1) RETURN T1 IS
250 BEGIN
251 IF X = ORANGE THEN
252 RETURN GREEN;
253 ELSE
254 RETURN ORANGE;
255 END IF;
256 END RET_T1;
257
258 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
259 BEGIN
260 RETURN T10(X);
261 END RET_CHAR;
262
263 PROCEDURE DO_NOTHING (X : IN OUT T3) IS
264 BEGIN
265 IF X = TRUE THEN
266 X := FALSE;
267 ELSE
268 X := TRUE;
269 END IF;
270 END DO_NOTHING;
271 END BPACK;
272 END APACK;
273 END GENPACK;
274
275 PACKAGE MYPACK IS NEW GENPACK (T1 => INTEGER);
276
277 PROCEDURE MY_DO_NOTHING IS NEW MYPACK.APACK.BPACK.DO_NOTHING;
278
279 BEGIN
280
281 -- B1: GENERIC INSTANCE OF UNOVERLOADED ENUMERATION LITERAL
282
283 IF MYPACK.APACK.BPACK."<"(MYPACK.APACK.BPACK.GREEN,
284 MYPACK.APACK.BPACK.ORANGE) THEN
285 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
286 "UNOVERLOADED ENUMERATION LITERAL BAD - B1");
287 END IF;
288
289
290 -- B2: GENERIC INSTANCE OF OVERLOADED ENUMERATION LITERAL
291
292 IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T2A'(MYPACK.
293 APACK.BPACK.'F'),MYPACK.APACK.BPACK.T2A'(MYPACK.APACK.
294 BPACK.'G')) THEN
295 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
296 "OVERLOADED ENUMERATION LITERAL BAD - B2");
297 END IF;
298
299
300 -- B3: VISIBILITY FOR GENERIC INSTANCE OF DERIVED BOOLEAN
301
302 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."NOT"(MYPACK.
303 APACK.BPACK.T3'(MYPACK.APACK.BPACK.TRUE)),MYPACK.APACK.
304 BPACK.FALSE) THEN
305 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
306 "BOOLEAN BAD - B3");
307 END IF;
308
309
310 -- B4: VISIBILITY FOR GENERIC INSTANCE OF DERIVED INTEGER
311
312 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."MOD"(MYPACK.
313 APACK.BPACK.SIX,2),0) THEN
314 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF INTEGER " &
315 "BAD - B4");
316 END IF;
317
318
319 -- B5: VISIBILITY FOR GENERIC INSTANCE OF FLOATING POINT
320
321 IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T5'(1.9),MYPACK.
322 APACK.BPACK.B_FLT) THEN
323 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FLOATING " &
324 "POINT BAD - B5");
325 END IF;
326
327
328 -- B6: VISIBILITY FOR GENERIC INSTANCE OF
329 -- FIXED POINT UNARY PLUS
330
331 IF MYPACK.APACK.BPACK."<"(2.5,MYPACK.APACK.BPACK.T67'(MYPACK.
332 APACK.BPACK."+"(1.75))) THEN
333 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
334 "POINT UNARY PLUS BAD - B6");
335 END IF;
336
337
338 -- B7: VISIBILITY FOR GENERIC INSTANCE OF
339 -- FIXED POINT DIVIDED BY INTEGER
340
341 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."/"(2.5,4),
342 0.625) THEN
343 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
344 "POINT DIVIDED BY INTEGER BAD - B7");
345 END IF;
346
347
348 -- B8: VISIBILITY FOR GENERIC INSTANCE OF ARRAY EQUALITY
349
350 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.ARY,(MYPACK.
351 APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE),MYPACK.
352 APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE))) THEN
353 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ARRAY " &
354 "EQUALITY BAD - B8");
355 END IF;
356
357
358 -- B9: VISIBILITY FOR GENERIC INSTANCE OF ACCESS EQUALITY
359
360 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.P1(3),MYPACK.
361 APACK.BPACK.T3(IDENT_BOOL(FALSE))) THEN
362 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ACCESS " &
363 "EQUALITY BAD - B9");
364 END IF;
365
366
367 -- B10: VISIBILITY FOR GENERIC INSTANCE OF PRIVATE EQUALITY
368
369 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.K1,MYPACK.APACK.
370 BPACK.RET_CHAR('V')) THEN
371 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF PRIVATE " &
372 "EQUALITY BAD - B10");
373 END IF;
374
375
376 -- B11: VISIBILITY FOR GENERIC INSTANCE OF DERIVED SUBPROGRAM
377
378 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.RET_T1(MYPACK.
379 APACK.BPACK.ORANGE),MYPACK.APACK.BPACK.GREEN) THEN
380 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
381 "SUBPROGRAM BAD - B11");
382 END IF;
383
384 -- B12: VISIBILITY FOR GENERIC INSTANCE OF GENERIC SUBPROGRAM
385
386 MY_DO_NOTHING (MYPACK.APACK.BPACK.V1);
387
388 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.V1,
389 MYPACK.APACK.BPACK.T3(FALSE)) THEN
390 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF GENERIC " &
391 "SUBPROGRAM BAD - B12");
392 END IF;
393
394 END B_BLOCK;
395
396 RESULT;
397 END C83051A;