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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C36204D.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 EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES.
26
-- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED. THIS TEST CHECKS 
27
-- THE ABOVE FOR ARRAYS WITHIN GENERIC PROGRAM UNITS.
28
 
29
-- HISTROY
30
--  EDWARD V. BERARD, 9 AUGUST 1990
31
 
32
WITH REPORT ;
33
WITH SYSTEM ;
34
 
35
PROCEDURE C36204D IS
36
 
37
    SHORT_START : CONSTANT := -10 ;
38
    SHORT_END    : CONSTANT := 10 ;
39
    TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
40
    SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
41
 
42
    TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
43
                        SEP, OCT, NOV, DEC) ;
44
    SUBTYPE MID_YEAR IS MONTH_TYPE RANGE MAY .. AUG ;
45
    TYPE DAY_TYPE IS RANGE 1 .. 31 ;
46
    TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
47
    TYPE DATE IS RECORD
48
      MONTH : MONTH_TYPE ;
49
      DAY   : DAY_TYPE ;
50
      YEAR  : YEAR_TYPE ;
51
    END RECORD ;
52
 
53
    TODAY         : DATE := (MONTH => AUG,
54
                             DAY   => 10,
55
                             YEAR  => 1990) ;
56
 
57
    FIRST_DATE     : DATE := (DAY   => 6,
58
                              MONTH => JUN,
59
                              YEAR  => 1967) ;
60
 
61
    FUNCTION "=" (LEFT  : IN SYSTEM.ADDRESS ;
62
                  RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN
63
            RENAMES SYSTEM."=" ;
64
 
65
    GENERIC
66
 
67
        TYPE FIRST_INDEX IS (<>) ;
68
        FIRST_INDEX_LENGTH : IN NATURAL ;
69
        FIRST_TEST_VALUE : IN FIRST_INDEX ;
70
        TYPE SECOND_INDEX IS (<>) ;
71
        SECOND_INDEX_LENGTH : IN NATURAL ;
72
        SECOND_TEST_VALUE : IN SECOND_INDEX ;
73
        TYPE THIRD_INDEX IS (<>) ;
74
        THIRD_INDEX_LENGTH : IN NATURAL ;
75
        THIRD_TEST_VALUE : IN THIRD_INDEX ;
76
        TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
77
        FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
78
        SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
79
        TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
80
        THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
81
        FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
82
 
83
    PACKAGE ARRAY_ATTRIBUTE_TEST IS
84
 
85
        TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
86
            OF FIRST_COMPONENT_TYPE ;
87
 
88
        TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
89
            OF SECOND_COMPONENT_TYPE ;
90
 
91
    END ARRAY_ATTRIBUTE_TEST ;
92
 
93
    PACKAGE BODY ARRAY_ATTRIBUTE_TEST IS
94
 
95
        FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
96
                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
97
                                    FIRST_DEFAULT_VALUE)) ;
98
 
99
        SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
100
                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
101
                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
102
                                       THIRD_DEFAULT_VALUE))) ;
103
 
104
        THIRD_ARRAY : CONSTANT MATRIX
105
                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
106
                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
107
                                    SECOND_DEFAULT_VALUE)) ;
108
 
109
        FOURTH_ARRAY : CONSTANT CUBE
110
                            := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
111
                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
112
                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
113
                                       FOURTH_DEFAULT_VALUE))) ;
114
 
115
        FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
116
        FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
117
        FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
118
        FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
119
 
120
        SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
121
        SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
122
        SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
123
        SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
124
        SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
125
        SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
126
 
127
        FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
128
        FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
129
 
130
        SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
131
        SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
132
        SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
133
 
134
        MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
135
        CUBE_SIZE    : NATURAL := CUBE'SIZE ;
136
 
137
        FAA  : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
138
        SAA  : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
139
        TAA  : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
140
        FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
141
 
142
     BEGIN  -- ARRAY_ATTRIBUTE_TEST
143
 
144
        IF (FA1 /= FIRST_INDEX'FIRST) OR
145
           (FA3 /= SECOND_INDEX'FIRST) OR
146
           (SA1 /= FIRST_INDEX'FIRST) OR
147
           (SA3 /= SECOND_INDEX'FIRST) OR
148
           (SA5 /= THIRD_INDEX'FIRST) THEN
149
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST - PACKAGE") ;
150
        END IF ;
151
 
152
        IF (FA2 /= FIRST_INDEX'LAST) OR
153
           (FA4 /= SECOND_INDEX'LAST) OR
154
           (SA2 /= FIRST_INDEX'LAST) OR
155
           (SA4 /= SECOND_INDEX'LAST) OR
156
           (SA6 /= THIRD_INDEX'LAST) THEN
157
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST - PACKAGE") ;
158
        END IF ;
159
 
160
        IF (FAL1 /= FIRST_INDEX_LENGTH) OR
161
           (FAL2 /= SECOND_INDEX_LENGTH) OR
162
           (SAL1 /= FIRST_INDEX_LENGTH) OR
163
           (SAL2 /= SECOND_INDEX_LENGTH) OR
164
           (SAL3 /= THIRD_INDEX_LENGTH) THEN
165
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH - PACKAGE") ;
166
        END IF ;
167
 
168
        FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
169
            FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
170
                FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
171
                    SECOND_DEFAULT_VALUE ;
172
            END LOOP ;
173
        END LOOP ;
174
 
175
        IF FIRST_ARRAY /= THIRD_ARRAY THEN
176
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
177
                           "FOR 2-DIMENSIONAL ARRAY. - PACKAGE") ;
178
        END IF ;
179
 
180
        FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
181
            FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
182
                FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
183
                    SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
184
                        := FOURTH_DEFAULT_VALUE ;
185
                END LOOP ;
186
            END LOOP ;
187
        END LOOP ;
188
 
189
        IF SECOND_ARRAY /= FOURTH_ARRAY THEN
190
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
191
                           "FOR 3-DIMENSIONAL ARRAY. - PACKAGE") ;
192
        END IF ;
193
 
194
        IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
195
           (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
196
           (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
197
           (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
198
           (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
199
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
200
                           "- PACKAGE") ;
201
        END IF ;
202
 
203
        IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
204
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
205
                           "- PACKAGE") ;
206
        END IF ;
207
 
208
        IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
209
           OR (SAA = TAA) OR (TAA = FRAA) THEN
210
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
211
                           "- PACKAGE") ;
212
        END IF ;
213
 
214
    END ARRAY_ATTRIBUTE_TEST ;
215
 
216
    GENERIC
217
 
218
        TYPE FIRST_INDEX IS (<>) ;
219
        FIRST_INDEX_LENGTH : IN NATURAL ;
220
        FIRST_TEST_VALUE : IN FIRST_INDEX ;
221
        TYPE SECOND_INDEX IS (<>) ;
222
        SECOND_INDEX_LENGTH : IN NATURAL ;
223
        SECOND_TEST_VALUE : IN SECOND_INDEX ;
224
        TYPE THIRD_INDEX IS (<>) ;
225
        THIRD_INDEX_LENGTH : IN NATURAL ;
226
        THIRD_TEST_VALUE : IN THIRD_INDEX ;
227
        TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
228
        FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
229
        SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
230
        TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
231
        THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
232
        FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
233
 
234
    PROCEDURE PROC_ARRAY_ATT_TEST ;
235
 
236
    PROCEDURE PROC_ARRAY_ATT_TEST IS
237
 
238
        TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
239
            OF FIRST_COMPONENT_TYPE ;
240
 
241
        TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
242
            OF SECOND_COMPONENT_TYPE ;
243
 
244
        FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
245
                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
246
                                    FIRST_DEFAULT_VALUE)) ;
247
 
248
        SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
249
                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
250
                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
251
                                       THIRD_DEFAULT_VALUE))) ;
252
 
253
        THIRD_ARRAY : CONSTANT MATRIX
254
                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
255
                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
256
                                    SECOND_DEFAULT_VALUE)) ;
257
 
258
        FOURTH_ARRAY : CONSTANT CUBE
259
                            := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
260
                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
261
                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
262
                                       FOURTH_DEFAULT_VALUE))) ;
263
 
264
        FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
265
        FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
266
        FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
267
        FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
268
 
269
        SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
270
        SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
271
        SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
272
        SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
273
        SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
274
        SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
275
 
276
        FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
277
        FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
278
 
279
        SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
280
        SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
281
        SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
282
 
283
        MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
284
        CUBE_SIZE    : NATURAL := CUBE'SIZE ;
285
 
286
        FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
287
        SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
288
        TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
289
        FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
290
 
291
     BEGIN  -- PROC_ARRAY_ATT_TEST
292
 
293
        IF (FA1 /= FIRST_INDEX'FIRST) OR
294
           (FA3 /= SECOND_INDEX'FIRST) OR
295
           (SA1 /= FIRST_INDEX'FIRST) OR
296
           (SA3 /= SECOND_INDEX'FIRST) OR
297
           (SA5 /= THIRD_INDEX'FIRST) THEN
298
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
299
                           "- PROCEDURE") ;
300
        END IF ;
301
 
302
        IF (FA2 /= FIRST_INDEX'LAST) OR
303
           (FA4 /= SECOND_INDEX'LAST) OR
304
           (SA2 /= FIRST_INDEX'LAST) OR
305
           (SA4 /= SECOND_INDEX'LAST) OR
306
           (SA6 /= THIRD_INDEX'LAST) THEN
307
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
308
                           "- PROCEDURE") ;
309
        END IF ;
310
 
311
        IF (FAL1 /= FIRST_INDEX_LENGTH) OR
312
           (FAL2 /= SECOND_INDEX_LENGTH) OR
313
           (SAL1 /= FIRST_INDEX_LENGTH) OR
314
           (SAL2 /= SECOND_INDEX_LENGTH) OR
315
           (SAL3 /= THIRD_INDEX_LENGTH) THEN
316
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
317
                           "- PROCEDURE") ;
318
        END IF ;
319
 
320
        FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
321
            FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
322
                FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
323
                    SECOND_DEFAULT_VALUE ;
324
            END LOOP ;
325
        END LOOP ;
326
 
327
        IF FIRST_ARRAY /= THIRD_ARRAY THEN
328
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
329
                           "FOR 2-DIMENSIONAL ARRAY. - PROCEDURE") ;
330
        END IF ;
331
 
332
        FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
333
            FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
334
                FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
335
                    SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
336
                        := FOURTH_DEFAULT_VALUE ;
337
                END LOOP ;
338
            END LOOP ;
339
        END LOOP ;
340
 
341
        IF SECOND_ARRAY /= FOURTH_ARRAY THEN
342
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
343
                           "FOR 3-DIMENSIONAL ARRAY. - PROCEDURE") ;
344
        END IF ;
345
 
346
        IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
347
           (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
348
           (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
349
           (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
350
           (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
351
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
352
                           "- PROCEDURE") ;
353
        END IF ;
354
 
355
        IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
356
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
357
                           "- PROCEDURE") ;
358
        END IF ;
359
 
360
        IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
361
           OR (SAA = TAA) OR (TAA = FRAA) THEN
362
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
363
                           "- PROCEDURE") ;
364
        END IF ;
365
 
366
    END PROC_ARRAY_ATT_TEST ;
367
 
368
    GENERIC
369
 
370
        TYPE FIRST_INDEX IS (<>) ;
371
        FIRST_INDEX_LENGTH : IN NATURAL ;
372
        FIRST_TEST_VALUE : IN FIRST_INDEX ;
373
        TYPE SECOND_INDEX IS (<>) ;
374
        SECOND_INDEX_LENGTH : IN NATURAL ;
375
        SECOND_TEST_VALUE : IN SECOND_INDEX ;
376
        TYPE THIRD_INDEX IS (<>) ;
377
        THIRD_INDEX_LENGTH : IN NATURAL ;
378
        THIRD_TEST_VALUE : IN THIRD_INDEX ;
379
        TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
380
        FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
381
        SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
382
        TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
383
        THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
384
        FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
385
 
386
    FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN ;
387
 
388
    FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN IS
389
 
390
        TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
391
            OF FIRST_COMPONENT_TYPE ;
392
 
393
        TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
394
            OF SECOND_COMPONENT_TYPE ;
395
 
396
        FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
397
                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
398
                                    FIRST_DEFAULT_VALUE)) ;
399
 
400
        SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
401
                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
402
                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
403
                                       THIRD_DEFAULT_VALUE))) ;
404
 
405
        THIRD_ARRAY : CONSTANT MATRIX
406
                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
407
                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
408
                                    SECOND_DEFAULT_VALUE)) ;
409
 
410
        FOURTH_ARRAY : CONSTANT CUBE
411
                            := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
412
                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
413
                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
414
                                       FOURTH_DEFAULT_VALUE))) ;
415
 
416
        FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
417
        FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
418
        FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
419
        FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
420
 
421
        SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
422
        SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
423
        SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
424
        SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
425
        SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
426
        SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
427
 
428
        FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
429
        FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
430
 
431
        SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
432
        SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
433
        SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
434
 
435
        MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
436
        CUBE_SIZE    : NATURAL := CUBE'SIZE ;
437
 
438
        FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
439
        SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
440
        TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
441
        FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
442
 
443
     BEGIN  -- FUNC_ARRAY_ATT_TEST
444
 
445
        IF (FA1 /= FIRST_INDEX'FIRST) OR
446
           (FA3 /= SECOND_INDEX'FIRST) OR
447
           (SA1 /= FIRST_INDEX'FIRST) OR
448
           (SA3 /= SECOND_INDEX'FIRST) OR
449
           (SA5 /= THIRD_INDEX'FIRST) THEN
450
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
451
                           "- FUNCTION") ;
452
        END IF ;
453
 
454
        IF (FA2 /= FIRST_INDEX'LAST) OR
455
           (FA4 /= SECOND_INDEX'LAST) OR
456
           (SA2 /= FIRST_INDEX'LAST) OR
457
           (SA4 /= SECOND_INDEX'LAST) OR
458
           (SA6 /= THIRD_INDEX'LAST) THEN
459
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
460
                           "- FUNCTION") ;
461
        END IF ;
462
 
463
        IF (FAL1 /= FIRST_INDEX_LENGTH) OR
464
           (FAL2 /= SECOND_INDEX_LENGTH) OR
465
           (SAL1 /= FIRST_INDEX_LENGTH) OR
466
           (SAL2 /= SECOND_INDEX_LENGTH) OR
467
           (SAL3 /= THIRD_INDEX_LENGTH) THEN
468
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
469
                           "- FUNCTION") ;
470
        END IF ;
471
 
472
        FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
473
            FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
474
                FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
475
                    SECOND_DEFAULT_VALUE ;
476
            END LOOP ;
477
        END LOOP ;
478
 
479
        IF FIRST_ARRAY /= THIRD_ARRAY THEN
480
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
481
                           "FOR 2-DIMENSIONAL ARRAY. - FUNCTION") ;
482
        END IF ;
483
 
484
        FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
485
            FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
486
                FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
487
                    SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
488
                        := FOURTH_DEFAULT_VALUE ;
489
                END LOOP ;
490
            END LOOP ;
491
        END LOOP ;
492
 
493
        IF SECOND_ARRAY /= FOURTH_ARRAY THEN
494
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
495
                           "FOR 3-DIMENSIONAL ARRAY. - FUNCTION") ;
496
        END IF ;
497
 
498
        IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
499
           (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
500
           (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
501
           (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
502
           (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
503
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
504
                           "- FUNCTION") ;
505
        END IF ;
506
 
507
        IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
508
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
509
                           "- FUNCTION") ;
510
        END IF ;
511
 
512
        IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
513
           OR (SAA = TAA) OR (TAA = FRAA) THEN
514
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
515
                           "- FUNCTION") ;
516
        END IF ;
517
 
518
        RETURN TRUE ;
519
 
520
    END FUNC_ARRAY_ATT_TEST ;
521
 
522
 
523
BEGIN -- C36204D
524
 
525
    REPORT.TEST ("C36204D", "ARRAY ATTRIBUTES RETURN CORRECT " &
526
                  "VALUES WITHIN GENERIC PROGRAM UNITS.") ;
527
 
528
    LOCAL_BLOCK:
529
 
530
    DECLARE
531
 
532
        DUMMY : BOOLEAN := FALSE ;
533
 
534
        PACKAGE NEW_ARRAY_ATTRIBUTE_TEST IS NEW ARRAY_ATTRIBUTE_TEST (
535
            FIRST_INDEX             => SHORT_RANGE,
536
            FIRST_INDEX_LENGTH      => SHORT_LENGTH,
537
            FIRST_TEST_VALUE        => -7,
538
            SECOND_INDEX            => MONTH_TYPE,
539
            SECOND_INDEX_LENGTH     => 12,
540
            SECOND_TEST_VALUE       => AUG,
541
            THIRD_INDEX             => BOOLEAN,
542
            THIRD_INDEX_LENGTH      => 2,
543
            THIRD_TEST_VALUE        => FALSE,
544
            FIRST_COMPONENT_TYPE    => MONTH_TYPE,
545
            FIRST_DEFAULT_VALUE     => JAN,
546
            SECOND_DEFAULT_VALUE    => DEC,
547
            SECOND_COMPONENT_TYPE   => DATE,
548
            THIRD_DEFAULT_VALUE     => TODAY,
549
            FOURTH_DEFAULT_VALUE    => FIRST_DATE) ;
550
 
551
        PROCEDURE NEW_PROC_ARRAY_ATT_TEST IS NEW PROC_ARRAY_ATT_TEST (
552
            FIRST_INDEX             => MONTH_TYPE,
553
            FIRST_INDEX_LENGTH      => 12,
554
            FIRST_TEST_VALUE        => AUG,
555
            SECOND_INDEX            => SHORT_RANGE,
556
            SECOND_INDEX_LENGTH     => SHORT_LENGTH,
557
            SECOND_TEST_VALUE       => -7,
558
            THIRD_INDEX             => BOOLEAN,
559
            THIRD_INDEX_LENGTH      => 2,
560
            THIRD_TEST_VALUE        => FALSE,
561
            FIRST_COMPONENT_TYPE    => DATE,
562
            FIRST_DEFAULT_VALUE     => TODAY,
563
            SECOND_DEFAULT_VALUE    => FIRST_DATE,
564
            SECOND_COMPONENT_TYPE   => MONTH_TYPE,
565
            THIRD_DEFAULT_VALUE     => JAN,
566
            FOURTH_DEFAULT_VALUE    => DEC) ;
567
 
568
        FUNCTION NEW_FUNC_ARRAY_ATT_TEST IS NEW FUNC_ARRAY_ATT_TEST (
569
            FIRST_INDEX             => DAY_TYPE,
570
            FIRST_INDEX_LENGTH      => 31,
571
            FIRST_TEST_VALUE        => 25,
572
            SECOND_INDEX            => SHORT_RANGE,
573
            SECOND_INDEX_LENGTH     => SHORT_LENGTH,
574
            SECOND_TEST_VALUE       => -7,
575
            THIRD_INDEX             => MID_YEAR,
576
            THIRD_INDEX_LENGTH      => 4,
577
            THIRD_TEST_VALUE        => JUL,
578
            FIRST_COMPONENT_TYPE    => DATE,
579
            FIRST_DEFAULT_VALUE     => TODAY,
580
            SECOND_DEFAULT_VALUE    => FIRST_DATE,
581
            SECOND_COMPONENT_TYPE   => MONTH_TYPE,
582
            THIRD_DEFAULT_VALUE     => JAN,
583
            FOURTH_DEFAULT_VALUE    => DEC) ;
584
 
585
    BEGIN  -- LOCAL_BLOCK
586
 
587
        NEW_PROC_ARRAY_ATT_TEST ;
588
 
589
        DUMMY := NEW_FUNC_ARRAY_ATT_TEST ;
590
        IF NOT DUMMY THEN
591
            REPORT.FAILED ("WRONG VALUE RETURNED BY FUNCTION.") ;
592
        END IF ;
593
 
594
    END LOCAL_BLOCK ;
595
 
596
    REPORT.RESULT ;
597
 
598
END C36204D ;

powered by: WebSVN 2.1.0

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