3 -- Grant of Unlimited Rights
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
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.
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
31 -- SEE AI-00365/05-BI-WJ.
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.
45 INCREMENTED_VALUE
: NATURAL := 0;
47 TYPE MONTH_TYPE
IS (JAN
, FEB
, MAR
, APR
, MAY
, JUN
, JUL
, AUG
,
49 TYPE DAY_TYPE
IS RANGE 1 .. 31;
50 TYPE YEAR_TYPE
IS RANGE 1904 .. 2050;
57 TYPE DATE_ACCESS
IS ACCESS DATE
;
59 TODAY
: DATE
:= (MONTH
=> AUG
,
63 CHRISTMAS
: DATE
:= (MONTH
=> DEC
,
67 WALL_DATE
: DATE
:= (MONTH
=> NOV
,
71 BIRTH_DATE
: DATE
:= (MONTH
=> OCT
,
75 FIRST_DUE_DATE
: DATE
:= (MONTH
=> JAN
,
79 LAST_DUE_DATE
: DATE
:= (MONTH
=> DEC
,
83 THIS_MONTH
: MONTH_TYPE
:= AUG
;
85 STORED_RECORD
: DATE
:= TODAY
;
87 STORED_INDEX
: MONTH_TYPE
:= AUG
;
89 FIRST_DATE
: DATE_ACCESS
:= NEW DATE
'(WALL_DATE);
90 SECOND_DATE : DATE_ACCESS := FIRST_DATE;
92 THIRD_DATE : DATE_ACCESS := NEW DATE'(BIRTH_DATE
);
93 FOURTH_DATE
: DATE_ACCESS
:= NEW DATE
'(CHRISTMAS);
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));
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;
118 PACKAGE TEST_ACTUAL_PARAMETERS IS
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;
128 END TEST_ACTUAL_PARAMETERS;
130 PACKAGE BODY TEST_ACTUAL_PARAMETERS IS
132 PROCEDURE EVALUATE_FUNCTION IS
133 BEGIN -- EVALUATE_FUNCTION
135 IF (INCREMENTED_VALUE = 0) OR
136 (NATURALLY /= INCREMENTED_VALUE) THEN
137 REPORT.FAILED ("PROBLEMS EVALUATING FUNCTION " &
141 END EVALUATE_FUNCTION;
143 PROCEDURE CHECK_RECORDS IS
147 BEGIN -- CHECK_RECORDS
149 IF STORED_RECORD /= FIRST_RECORD THEN
150 REPORT.FAILED ("PROBLEM WITH RECORD TYPES");
152 STORED_RECORD := SECOND_RECORD;
153 STORE := FIRST_RECORD;
154 FIRST_RECORD := SECOND_RECORD;
155 SECOND_RECORD := STORE;
160 PROCEDURE CHECK_ACCESS IS
161 BEGIN -- CHECK_ACCESS
163 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
165 IF POINTER.ALL /= DATE'(WALL_DATE
) THEN
166 REPORT
.FAILED
("PROBLEM WITH ACCESS TYPES " &
169 POINTER
.ALL := DATE
'(BIRTH_DATE);
172 IF POINTER.ALL /= DATE'(BIRTH_DATE
) THEN
173 REPORT
.FAILED
("PROBLEM WITH ACCESS TYPES " &
176 POINTER
.ALL := DATE
'(WALL_DATE);
182 PROCEDURE CHECK_ARRAY IS
188 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
190 IF THIS_ARRAY (THIS_ARRAY'FIRST) /= FIRST_DUE_DATE
192 REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 1");
194 THIS_ARRAY (THIS_ARRAY'FIRST) := LAST_DUE_DATE;
195 THIS_ARRAY (THIS_ARRAY'LAST) := FIRST_DUE_DATE;
198 IF THIS_ARRAY (THIS_ARRAY'FIRST) /= LAST_DUE_DATE
200 REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 2");
202 THIS_ARRAY (THIS_ARRAY'FIRST) :=
204 THIS_ARRAY (THIS_ARRAY'LAST) := LAST_DUE_DATE;
210 PROCEDURE CHECK_ARRAY_ELEMENTS IS
214 BEGIN -- CHECK_ARRAY_ELEMENTS
216 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
218 IF (FIRST_ARRAY_ELEMENT.MONTH /= MAY) OR
219 (SECOND_ARRAY_ELEMENT.DAY /= 22) THEN
220 REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
223 STORE := FIRST_ARRAY_ELEMENT;
224 FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
225 SECOND_ARRAY_ELEMENT := STORE;
228 IF (FIRST_ARRAY_ELEMENT.MONTH /= JUN) OR
229 (SECOND_ARRAY_ELEMENT.DAY /= 23) THEN
230 REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
233 STORE := FIRST_ARRAY_ELEMENT;
234 FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
235 SECOND_ARRAY_ELEMENT := STORE;
239 END CHECK_ARRAY_ELEMENTS;
241 PROCEDURE CHECK_SCALAR IS
242 BEGIN -- CHECK_SCALAR
244 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
246 IF INDEX_ELEMENT /= STORED_INDEX THEN
247 REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 1");
250 MONTH_TYPE'SUCC(INDEX_ELEMENT);
251 STORED_INDEX := INDEX_ELEMENT;
254 IF INDEX_ELEMENT /= STORED_INDEX THEN
255 REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 2");
258 MONTH_TYPE'PRED (INDEX_ELEMENT);
259 STORED_INDEX := INDEX_ELEMENT;
265 PROCEDURE CHECK_POINTERS IS
269 BEGIN -- CHECK_POINTERS
271 IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
273 IF (POINTER_TEST /= DATE'(OCT
, 3, 1949)) OR
274 (ANOTHER_POINTER_TEST
/= DATE
'(DEC, 25, 1948))
276 REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
279 STORE := POINTER_TEST;
280 POINTER_TEST := ANOTHER_POINTER_TEST;
281 ANOTHER_POINTER_TEST := STORE;
284 IF (POINTER_TEST /= DATE'(DEC
, 25, 1948)) OR
285 (ANOTHER_POINTER_TEST
/= DATE
'(OCT, 3, 1949))
287 REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
290 STORE := POINTER_TEST;
291 POINTER_TEST := ANOTHER_POINTER_TEST;
292 ANOTHER_POINTER_TEST := STORE;
298 END TEST_ACTUAL_PARAMETERS;
300 FUNCTION INC RETURN NATURAL IS
302 INCREMENTED_VALUE := NATURAL'SUCC (INCREMENTED_VALUE);
303 RETURN INCREMENTED_VALUE;
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.");
320 M1 : MONTH_TYPE := MAY;
321 M2 : MONTH_TYPE := JUN;
323 PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
324 NEW TEST_ACTUAL_PARAMETERS (
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);
340 REPORT.COMMENT ("ENTERING FIRST BLOCK");
341 NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
342 NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
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;
359 SAVE_THIRD_DATE : DATE_ACCESS := THIRD_DATE;
360 SAVE_FOURTH_DATE : DATE_ACCESS := FOURTH_DATE;
362 PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
363 NEW TEST_ACTUAL_PARAMETERS (
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);
377 BEGIN -- SECOND_BLOCK
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;
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;