Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c4/c45282b.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 -- C45282B.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 -- CHECK THAT IN AND NOT IN ARE EVALUATED CORRECTLY FOR :
26 -- D) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH
27 -- DISCRIMINANTS (WITH AND WITHOUT DEFAULT VALUES), WHERE THE
28 -- TYPE MARK DENOTES A CONSTRAINED AND UNCONSTRAINED TYPE;
29 -- E) ACCESS TO TASK TYPES.
30
31 -- TBN 8/8/86
32
33 WITH REPORT; USE REPORT;
34 PROCEDURE C45282B IS
35
36 SUBTYPE INT IS INTEGER RANGE 1 .. 5;
37
38 PACKAGE P IS
39 TYPE PRI_REC1 (D : INT) IS PRIVATE;
40 TYPE PRI_REC2 (D : INT := 2) IS PRIVATE;
41 FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1;
42 FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2;
43 TYPE LIM_REC1 (D : INT) IS LIMITED PRIVATE;
44 TYPE ACC_LIM1 IS ACCESS LIM_REC1;
45 SUBTYPE ACC_SUB_LIM1 IS ACC_LIM1 (2);
46 PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING);
47 TYPE LIM_REC2 (D : INT := 2) IS LIMITED PRIVATE;
48 TYPE ACC_LIM2 IS ACCESS LIM_REC2;
49 SUBTYPE ACC_SUB_LIM2 IS ACC_LIM2 (2);
50 PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING);
51 PRIVATE
52 TYPE PRI_REC1 (D : INT) IS
53 RECORD
54 STR : STRING (1 .. D);
55 END RECORD;
56 TYPE PRI_REC2 (D : INT := 2) IS
57 RECORD
58 STR : STRING (1 .. D);
59 END RECORD;
60 TYPE LIM_REC1 (D : INT) IS
61 RECORD
62 STR : STRING (1 .. D);
63 END RECORD;
64 TYPE LIM_REC2 (D : INT := 2) IS
65 RECORD
66 STR : STRING (1 .. D);
67 END RECORD;
68 END P;
69
70 USE P;
71
72 TYPE DIS_REC1 (D : INT) IS
73 RECORD
74 STR : STRING (1 .. D);
75 END RECORD;
76 TYPE DIS_REC2 (D : INT := 5) IS
77 RECORD
78 STR : STRING (D .. 8);
79 END RECORD;
80
81 TYPE ACC1_REC1 IS ACCESS DIS_REC1;
82 SUBTYPE ACC2_REC1 IS ACC1_REC1 (2);
83 TYPE ACC1_REC2 IS ACCESS DIS_REC2;
84 SUBTYPE ACC2_REC2 IS ACC1_REC2 (2);
85 REC1 : ACC1_REC1;
86 REC2 : ACC2_REC1;
87 REC3 : ACC1_REC2;
88 REC4 : ACC2_REC2;
89 TYPE ACC_PREC1 IS ACCESS PRI_REC1;
90 SUBTYPE ACC_SREC1 IS ACC_PREC1 (2);
91 REC5 : ACC_PREC1;
92 REC6 : ACC_SREC1;
93 TYPE ACC_PREC2 IS ACCESS PRI_REC2;
94 SUBTYPE ACC_SREC2 IS ACC_PREC2 (2);
95 REC7 : ACC_PREC2;
96 REC8 : ACC_SREC2;
97 REC9 : ACC_LIM1;
98 REC10 : ACC_SUB_LIM1;
99 REC11 : ACC_LIM2;
100 REC12 : ACC_SUB_LIM2;
101
102 TASK TYPE T IS
103 ENTRY E (X : INTEGER);
104 END T;
105
106 TASK BODY T IS
107 BEGIN
108 ACCEPT E (X : INTEGER) DO
109 IF X /= IDENT_INT(1) THEN
110 FAILED ("INCORRECT VALUE PASSED TO TASK");
111 END IF;
112 END E;
113 END T;
114
115 PACKAGE BODY P IS
116 FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1 IS
117 REC : PRI_REC1 (A);
118 BEGIN
119 REC := (A, B);
120 RETURN (REC);
121 END INIT_PREC1;
122
123 FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2 IS
124 REC : PRI_REC2;
125 BEGIN
126 REC := (A, B);
127 RETURN (REC);
128 END INIT_PREC2;
129
130 PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING) IS
131 BEGIN
132 A.ALL := (B, C);
133 END ASSIGN_LIM1;
134
135 PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING) IS
136 BEGIN
137 A.ALL := (B, C);
138 END ASSIGN_LIM2;
139 END P;
140
141 BEGIN
142
143 TEST ("C45282B", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
144 "ACCESS TYPES TO RECORD TYPES, PRIVATE TYPES, " &
145 "LIMITED PRIVATE TYPES WITH DISCRIMINANTS, AND " &
146 "TASK TYPES");
147
148 -- CASE D
149 ------------------------------------------------------------------------
150 IF REC1 NOT IN ACC1_REC1 THEN
151 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
152 END IF;
153 IF REC1 IN ACC2_REC1 THEN
154 NULL;
155 ELSE
156 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
157 END IF;
158 IF REC2 NOT IN ACC1_REC1 THEN
159 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
160 END IF;
161 REC1 := NEW DIS_REC1'(5, "12345");
162 IF REC1 IN ACC1_REC1 THEN
163 NULL;
164 ELSE
165 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
166 END IF;
167 IF REC1 IN ACC2_REC1 THEN
168 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
169 END IF;
170 REC2 := NEW DIS_REC1'(2, "HI");
171 IF REC2 IN ACC1_REC1 THEN
172 NULL;
173 ELSE
174 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
175 END IF;
176
177 ------------------------------------------------------------------------
178
179 IF REC3 IN ACC1_REC2 THEN
180 NULL;
181 ELSE
182 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
183 END IF;
184 IF REC3 NOT IN ACC2_REC2 THEN
185 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
186 END IF;
187 IF REC4 IN ACC1_REC2 THEN
188 NULL;
189 ELSE
190 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
191 END IF;
192 REC3 := NEW DIS_REC2'(5, "5678");
193 IF REC3 IN ACC1_REC2 THEN
194 NULL;
195 ELSE
196 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
197 END IF;
198 IF REC3 IN ACC2_REC2 THEN
199 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
200 END IF;
201 REC4 := NEW DIS_REC2'(2, "2345678");
202 IF REC4 IN ACC1_REC2 THEN
203 NULL;
204 ELSE
205 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
206 END IF;
207 IF REC4 NOT IN ACC2_REC2 THEN
208 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
209 END IF;
210
211 ------------------------------------------------------------------------
212
213 IF REC5 NOT IN ACC_PREC1 THEN
214 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
215 END IF;
216 IF REC5 NOT IN ACC_SREC1 THEN
217 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
218 END IF;
219 IF REC6 NOT IN ACC_PREC1 THEN
220 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
221 END IF;
222 REC5 := NEW PRI_REC1'(INIT_PREC1 (5, "12345"));
223 IF REC5 IN ACC_PREC1 THEN
224 NULL;
225 ELSE
226 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
227 END IF;
228 IF REC5 IN ACC_SREC1 THEN
229 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
230 END IF;
231 REC6 := NEW PRI_REC1'(INIT_PREC1 (2, "HI"));
232 IF REC6 IN ACC_PREC1 THEN
233 NULL;
234 ELSE
235 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 19");
236 END IF;
237
238 ------------------------------------------------------------------------
239
240 IF REC7 NOT IN ACC_PREC2 THEN
241 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 20");
242 END IF;
243 IF REC7 NOT IN ACC_SREC2 THEN
244 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 21");
245 END IF;
246 IF REC8 NOT IN ACC_PREC2 THEN
247 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 22");
248 END IF;
249 REC7 := NEW PRI_REC2'(INIT_PREC2 (5, "12345"));
250 IF REC7 IN ACC_PREC2 THEN
251 NULL;
252 ELSE
253 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 23");
254 END IF;
255 IF REC7 IN ACC_SREC2 THEN
256 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 24");
257 END IF;
258 REC8 := NEW PRI_REC2'(INIT_PREC2 (2, "HI"));
259 IF REC8 IN ACC_PREC2 THEN
260 NULL;
261 ELSE
262 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 25");
263 END IF;
264
265 ------------------------------------------------------------------------
266
267 IF REC9 NOT IN ACC_LIM1 THEN
268 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 26");
269 END IF;
270 IF REC9 NOT IN ACC_SUB_LIM1 THEN
271 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 27");
272 END IF;
273 IF REC10 NOT IN ACC_LIM1 THEN
274 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 28");
275 END IF;
276 REC9 := NEW LIM_REC1 (5);
277 ASSIGN_LIM1 (REC9, 5, "12345");
278 IF REC9 IN ACC_LIM1 THEN
279 NULL;
280 ELSE
281 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 29");
282 END IF;
283 IF REC9 IN ACC_SUB_LIM1 THEN
284 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 30");
285 END IF;
286 REC10 := NEW LIM_REC1 (2);
287 ASSIGN_LIM1 (REC10, 2, "12");
288 IF REC10 IN ACC_LIM1 THEN
289 NULL;
290 ELSE
291 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 31");
292 END IF;
293
294 ------------------------------------------------------------------------
295
296 IF REC11 NOT IN ACC_LIM2 THEN
297 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 32");
298 END IF;
299 IF REC11 NOT IN ACC_SUB_LIM2 THEN
300 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 33");
301 END IF;
302 IF REC12 NOT IN ACC_LIM2 THEN
303 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 34");
304 END IF;
305 REC11 := NEW LIM_REC2;
306 IF REC11 NOT IN ACC_SUB_LIM2 THEN
307 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 35");
308 END IF;
309 ASSIGN_LIM2 (REC11, 2, "12");
310 IF REC11 IN ACC_LIM2 THEN
311 NULL;
312 ELSE
313 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 36");
314 END IF;
315 IF REC11 IN ACC_SUB_LIM2 THEN
316 NULL;
317 ELSE
318 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 37");
319 END IF;
320 REC12 := NEW LIM_REC2;
321 ASSIGN_LIM2 (REC12, 2, "12");
322 IF REC12 IN ACC_LIM2 THEN
323 NULL;
324 ELSE
325 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
326 END IF;
327
328 -- CASE E
329 ------------------------------------------------------------------------
330 DECLARE
331 TYPE ACC_TASK IS ACCESS T;
332 T1 : ACC_TASK;
333 BEGIN
334 IF T1 NOT IN ACC_TASK THEN
335 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 39");
336 END IF;
337 T1 := NEW T;
338 IF T1 IN ACC_TASK THEN
339 NULL;
340 ELSE
341 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
342 END IF;
343 T1.E (1);
344 END;
345
346 RESULT;
347 END C45282B;