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
41WITH REPORT;
42
43PROCEDURE 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
306BEGIN  -- 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
397END CC3007B;
398