OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc3007b.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.