|
111
|
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;
|
