Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cc/cc3007b.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 -- CC3007B.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 THE NAMES IN A GENERIC INSTANTIATION ARE STATICALLY
26 -- IDENTIFIED (I.E., BOUND) AT THE TEXTUAL POINT OF THE INSTANTIA-
27 -- TION, AND ARE BOUND BEFORE BEING "SUBSTITUTED" FOR THE COR-
28 -- RESPONDING GENERIC FORMAL PARAMETERS IN THE SPECIFICATION AND
29 -- BODY TEMPLATES.
30 --
31 -- SEE AI-00365/05-BI-WJ.
32
33 -- HISTORY:
34 -- EDWARD V. BERARD, 15 AUGUST 1990
35 -- DAS 08 OCT 90 CHANGED INSTANTIATIONS TO USE VARIABLES
36 -- M1 AND M2 IN THE FIRST_BLOCK INSTANTIA-
37 -- TION AND TO ASSIGN THIRD_DATE AND
38 -- FOURTH_DATE VALUES BEFORE AND AFTER THE
39 -- SECOND_BLOCK INSTANTIATION.
40
41 WITH REPORT;
42
43 PROCEDURE CC3007B IS
44
45 INCREMENTED_VALUE : NATURAL := 0;
46
47 TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
48 SEP, OCT, NOV, DEC);
49 TYPE DAY_TYPE IS RANGE 1 .. 31;
50 TYPE YEAR_TYPE IS RANGE 1904 .. 2050;
51 TYPE DATE IS RECORD
52 MONTH : MONTH_TYPE;
53 DAY : DAY_TYPE;
54 YEAR : YEAR_TYPE;
55 END RECORD;
56
57 TYPE DATE_ACCESS IS ACCESS DATE;
58
59 TODAY : DATE := (MONTH => AUG,
60 DAY => 8,
61 YEAR => 1990);
62
63 CHRISTMAS : DATE := (MONTH => DEC,
64 DAY => 25,
65 YEAR => 1948);
66
67 WALL_DATE : DATE := (MONTH => NOV,
68 DAY => 9,
69 YEAR => 1989);
70
71 BIRTH_DATE : DATE := (MONTH => OCT,
72 DAY => 3,
73 YEAR => 1949);
74
75 FIRST_DUE_DATE : DATE := (MONTH => JAN,
76 DAY => 23,
77 YEAR => 1990);
78
79 LAST_DUE_DATE : DATE := (MONTH => DEC,
80 DAY => 20,
81 YEAR => 1990);
82
83 THIS_MONTH : MONTH_TYPE := AUG;
84
85 STORED_RECORD : DATE := TODAY;
86
87 STORED_INDEX : MONTH_TYPE := AUG;
88
89 FIRST_DATE : DATE_ACCESS := NEW DATE'(WALL_DATE);
90 SECOND_DATE : DATE_ACCESS := FIRST_DATE;
91
92 THIRD_DATE : DATE_ACCESS := NEW DATE'(BIRTH_DATE);
93 FOURTH_DATE : DATE_ACCESS := NEW DATE'(CHRISTMAS);
94
95 TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE;
96 REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),
97 (MAR, 23, 1990), (APR, 23, 1990),
98 (MAY, 23, 1990), (JUN, 22, 1990),
99 (JUL, 23, 1990), (AUG, 23, 1990),
100 (SEP, 24, 1990), (OCT, 23, 1990),
101 (NOV, 23, 1990), (DEC, 20, 1990));
102
103 GENERIC
104
105 NATURALLY : IN NATURAL;
106 FIRST_RECORD : IN OUT DATE;
107 SECOND_RECORD : IN OUT DATE;
108 TYPE RECORD_POINTER IS ACCESS DATE;
109 POINTER : IN OUT RECORD_POINTER;
110 TYPE ARRAY_TYPE IS ARRAY (MONTH_TYPE) OF DATE;
111 THIS_ARRAY : IN OUT ARRAY_TYPE;
112 FIRST_ARRAY_ELEMENT : IN OUT DATE;
113 SECOND_ARRAY_ELEMENT : IN OUT DATE;
114 INDEX_ELEMENT : IN OUT MONTH_TYPE;
115 POINTER_TEST : IN OUT DATE;
116 ANOTHER_POINTER_TEST : IN OUT DATE;
117
118 PACKAGE TEST_ACTUAL_PARAMETERS IS
119
120 PROCEDURE EVALUATE_FUNCTION;
121 PROCEDURE CHECK_RECORDS;
122 PROCEDURE CHECK_ACCESS;
123 PROCEDURE CHECK_ARRAY;
124 PROCEDURE CHECK_ARRAY_ELEMENTS;
125 PROCEDURE CHECK_SCALAR;
126 PROCEDURE CHECK_POINTERS;
127
128 END TEST_ACTUAL_PARAMETERS;
129
130 PACKAGE BODY TEST_ACTUAL_PARAMETERS IS
131
132 PROCEDURE EVALUATE_FUNCTION IS
133 BEGIN -- EVALUATE_FUNCTION
134
135 IF (INCREMENTED_VALUE = 0) OR
136 (NATURALLY /= INCREMENTED_VALUE) THEN
137 REPORT.FAILED ("PROBLEMS EVALUATING FUNCTION " &
138 "PARAMETER.");
139 END IF;
140
141 END EVALUATE_FUNCTION;
142
143 PROCEDURE CHECK_RECORDS IS
144
145 STORE : DATE;
146
147 BEGIN -- CHECK_RECORDS
148
149 IF STORED_RECORD /= FIRST_RECORD THEN
150 REPORT.FAILED ("PROBLEM WITH RECORD TYPES");
151 ELSE
152 STORED_RECORD := SECOND_RECORD;
153 STORE := FIRST_RECORD;
154 FIRST_RECORD := SECOND_RECORD;
155 SECOND_RECORD := STORE;
156 END IF;
157
158 END CHECK_RECORDS;
159
160 PROCEDURE CHECK_ACCESS IS
161 BEGIN -- CHECK_ACCESS
162
163 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
164 THEN
165 IF POINTER.ALL /= DATE'(WALL_DATE) THEN
166 REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
167 "- 1");
168 ELSE
169 POINTER.ALL := DATE'(BIRTH_DATE);
170 END IF;
171 ELSE
172 IF POINTER.ALL /= DATE'(BIRTH_DATE) THEN
173 REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
174 "- 2");
175 ELSE
176 POINTER.ALL := DATE'(WALL_DATE);
177 END IF;
178 END IF;
179
180 END CHECK_ACCESS;
181
182 PROCEDURE CHECK_ARRAY IS
183
184 STORE : DATE;
185
186 BEGIN -- CHECK_ARRAY
187
188 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
189 THEN
190 IF THIS_ARRAY (THIS_ARRAY'FIRST) /= FIRST_DUE_DATE
191 THEN
192 REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 1");
193 ELSE
194 THIS_ARRAY (THIS_ARRAY'FIRST) := LAST_DUE_DATE;
195 THIS_ARRAY (THIS_ARRAY'LAST) := FIRST_DUE_DATE;
196 END IF;
197 ELSE
198 IF THIS_ARRAY (THIS_ARRAY'FIRST) /= LAST_DUE_DATE
199 THEN
200 REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 2");
201 ELSE
202 THIS_ARRAY (THIS_ARRAY'FIRST) :=
203 FIRST_DUE_DATE;
204 THIS_ARRAY (THIS_ARRAY'LAST) := LAST_DUE_DATE;
205 END IF;
206 END IF;
207
208 END CHECK_ARRAY;
209
210 PROCEDURE CHECK_ARRAY_ELEMENTS IS
211
212 STORE : DATE;
213
214 BEGIN -- CHECK_ARRAY_ELEMENTS
215
216 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
217 THEN
218 IF (FIRST_ARRAY_ELEMENT.MONTH /= MAY) OR
219 (SECOND_ARRAY_ELEMENT.DAY /= 22) THEN
220 REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
221 "- 1");
222 ELSE
223 STORE := FIRST_ARRAY_ELEMENT;
224 FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
225 SECOND_ARRAY_ELEMENT := STORE;
226 END IF;
227 ELSE
228 IF (FIRST_ARRAY_ELEMENT.MONTH /= JUN) OR
229 (SECOND_ARRAY_ELEMENT.DAY /= 23) THEN
230 REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
231 "- 2");
232 ELSE
233 STORE := FIRST_ARRAY_ELEMENT;
234 FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
235 SECOND_ARRAY_ELEMENT := STORE;
236 END IF;
237 END IF;
238
239 END CHECK_ARRAY_ELEMENTS;
240
241 PROCEDURE CHECK_SCALAR IS
242 BEGIN -- CHECK_SCALAR
243
244 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
245 THEN
246 IF INDEX_ELEMENT /= STORED_INDEX THEN
247 REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 1");
248 ELSE
249 INDEX_ELEMENT :=
250 MONTH_TYPE'SUCC(INDEX_ELEMENT);
251 STORED_INDEX := INDEX_ELEMENT;
252 END IF;
253 ELSE
254 IF INDEX_ELEMENT /= STORED_INDEX THEN
255 REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 2");
256 ELSE
257 INDEX_ELEMENT :=
258 MONTH_TYPE'PRED (INDEX_ELEMENT);
259 STORED_INDEX := INDEX_ELEMENT;
260 END IF;
261 END IF;
262
263 END CHECK_SCALAR;
264
265 PROCEDURE CHECK_POINTERS IS
266
267 STORE : DATE;
268
269 BEGIN -- CHECK_POINTERS
270
271 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
272 THEN
273 IF (POINTER_TEST /= DATE'(OCT, 3, 1949)) OR
274 (ANOTHER_POINTER_TEST /= DATE'(DEC, 25, 1948))
275 THEN
276 REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
277 "- 1");
278 ELSE
279 STORE := POINTER_TEST;
280 POINTER_TEST := ANOTHER_POINTER_TEST;
281 ANOTHER_POINTER_TEST := STORE;
282 END IF;
283 ELSE
284 IF (POINTER_TEST /= DATE'(DEC, 25, 1948)) OR
285 (ANOTHER_POINTER_TEST /= DATE'(OCT, 3, 1949))
286 THEN
287 REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
288 "- 2");
289 ELSE
290 STORE := POINTER_TEST;
291 POINTER_TEST := ANOTHER_POINTER_TEST;
292 ANOTHER_POINTER_TEST := STORE;
293 END IF;
294 END IF;
295
296 END CHECK_POINTERS;
297
298 END TEST_ACTUAL_PARAMETERS;
299
300 FUNCTION INC RETURN NATURAL IS
301 BEGIN -- INC
302 INCREMENTED_VALUE := NATURAL'SUCC (INCREMENTED_VALUE);
303 RETURN INCREMENTED_VALUE;
304 END INC;
305
306 BEGIN -- CC3007B
307
308 REPORT.TEST ("CC3007B", "CHECK THAT THE NAMES IN A GENERIC " &
309 "INSTANTIATION ARE STAICALLY IDENTIFIED (I.E., " &
310 "BOUND) AT THE TEXTUAL POINT OF THE INSTANTIATION" &
311 ", AND ARE BOUND BEFORE BEING SUBSTITUTED FOR " &
312 "THE CORRESPONDING GENERIC FORMAL PARAMETERS IN " &
313 "THE SPECIFICATION AND BODY TEMPLATES. " &
314 "SEE AI-00365/05-BI-WJ.");
315
316 FIRST_BLOCK:
317
318 DECLARE
319
320 M1 : MONTH_TYPE := MAY;
321 M2 : MONTH_TYPE := JUN;
322
323 PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
324 NEW TEST_ACTUAL_PARAMETERS (
325 NATURALLY => INC,
326 FIRST_RECORD => TODAY,
327 SECOND_RECORD => CHRISTMAS,
328 RECORD_POINTER => DATE_ACCESS,
329 POINTER => SECOND_DATE,
330 ARRAY_TYPE => DUE_DATES,
331 THIS_ARRAY => REPORT_DATES,
332 FIRST_ARRAY_ELEMENT => REPORT_DATES (M1),
333 SECOND_ARRAY_ELEMENT => REPORT_DATES (M2),
334 INDEX_ELEMENT => THIS_MONTH,
335 POINTER_TEST => THIRD_DATE.ALL,
336 ANOTHER_POINTER_TEST => FOURTH_DATE.ALL);
337
338 BEGIN -- FIRST_BLOCK
339
340 REPORT.COMMENT ("ENTERING FIRST BLOCK");
341 NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
342 NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
343 M1 := SEP;
344 M2 := OCT;
345 -- NEW_TEST_ACTUAL_PARAMETERS SHOULD USE THE PREVIOUS
346 -- VALUES OF MAY AND JUN.
347 NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
348 NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
349 NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
350 NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
351 NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
352
353 END FIRST_BLOCK;
354
355 SECOND_BLOCK:
356
357 DECLARE
358
359 SAVE_THIRD_DATE : DATE_ACCESS := THIRD_DATE;
360 SAVE_FOURTH_DATE : DATE_ACCESS := FOURTH_DATE;
361
362 PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
363 NEW TEST_ACTUAL_PARAMETERS (
364 NATURALLY => INC,
365 FIRST_RECORD => TODAY,
366 SECOND_RECORD => CHRISTMAS,
367 RECORD_POINTER => DATE_ACCESS,
368 POINTER => SECOND_DATE,
369 ARRAY_TYPE => DUE_DATES,
370 THIS_ARRAY => REPORT_DATES,
371 FIRST_ARRAY_ELEMENT => REPORT_DATES (MAY),
372 SECOND_ARRAY_ELEMENT => REPORT_DATES (JUN),
373 INDEX_ELEMENT => THIS_MONTH,
374 POINTER_TEST => THIRD_DATE.ALL,
375 ANOTHER_POINTER_TEST => FOURTH_DATE.ALL);
376
377 BEGIN -- SECOND_BLOCK
378
379 REPORT.COMMENT ("ENTERING SECOND BLOCK");
380 NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
381 NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
382 NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
383 NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
384 NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
385 NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
386
387 THIRD_DATE := NEW DATE'(JUL, 13, 1951);
388 FOURTH_DATE := NEW DATE'(JUL, 4, 1976);
389 NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
390 THIRD_DATE := SAVE_THIRD_DATE;
391 FOURTH_DATE := SAVE_FOURTH_DATE;
392
393 END SECOND_BLOCK;
394
395 REPORT.RESULT;
396
397 END CC3007B;