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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C85006D.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
-- OBJECTIVE:
26
--     CHECK THAT A COMPONENT OR SLICE OF A VARIABLE CREATED BY A
27
--     GENERIC 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE
28
--     CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
29
--     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT'
30
--     OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
31
--     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
32
--     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
33
 
34
-- HISTORY:
35
--     JET 03/22/88  CREATED ORIGINAL TEST.
36
 
37
WITH REPORT; USE REPORT;
38
PROCEDURE C85006D IS
39
 
40
     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
41
     TYPE RECORD1 (D : INTEGER) IS
42
          RECORD
43
               FIELD1 : INTEGER := 1;
44
          END RECORD;
45
     TYPE POINTER1 IS ACCESS INTEGER;
46
 
47
     PACKAGE PACK1 IS
48
          TYPE PRIVY IS PRIVATE;
49
          ZERO : CONSTANT PRIVY;
50
          ONE : CONSTANT PRIVY;
51
          TWO : CONSTANT PRIVY;
52
          THREE : CONSTANT PRIVY;
53
          FOUR : CONSTANT PRIVY;
54
          FIVE : CONSTANT PRIVY;
55
          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
56
          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
57
     PRIVATE
58
          TYPE PRIVY IS RANGE 0..127;
59
          ZERO : CONSTANT PRIVY := 0;
60
          ONE : CONSTANT PRIVY := 1;
61
          TWO : CONSTANT PRIVY := 2;
62
          THREE : CONSTANT PRIVY := 3;
63
          FOUR : CONSTANT PRIVY := 4;
64
          FIVE : CONSTANT PRIVY := 5;
65
     END PACK1;
66
 
67
     TASK TYPE TASK1 IS
68
          ENTRY ASSIGN (J : IN INTEGER);
69
          ENTRY VALU (J : OUT INTEGER);
70
          ENTRY NEXT;
71
          ENTRY STOP;
72
     END TASK1;
73
 
74
     TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
75
     TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
76
     TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
77
     TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
78
     TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
79
     TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
80
 
81
     TYPE REC_TYPE IS RECORD
82
          RI1 : INTEGER := 0;
83
          RA1 : ARRAY1(1..3) := (OTHERS => 0);
84
          RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
85
          RP1 : POINTER1 := NEW INTEGER'(0);
86
          RV1 : PACK1.PRIVY := PACK1.ZERO;
87
          RT1 : TASK1;
88
     END RECORD;
89
 
90
     DREC : REC_TYPE;
91
 
92
     DAI1 : ARR_INT(1..8) := (OTHERS => 0);
93
     DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
94
     DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
95
     DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
96
     DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
97
     DAT1 : ARR_TSK(1..8);
98
 
99
     GENERIC
100
          REC : IN OUT REC_TYPE;
101
          AI1 : IN OUT ARR_INT;
102
          AA1 : IN OUT ARR_ARR;
103
          AR1 : IN OUT ARR_REC;
104
          AP1 : IN OUT ARR_PTR;
105
          AV1 : IN OUT ARR_PVT;
106
          AT1 : IN OUT ARR_TSK;
107
     PACKAGE GENERIC1 IS
108
     END GENERIC1;
109
 
110
     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
111
     BEGIN
112
          IF EQUAL (3,3) THEN
113
               RETURN P;
114
          ELSE
115
               RETURN NULL;
116
          END IF;
117
     END IDENT;
118
 
119
     PACKAGE BODY PACK1 IS
120
          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
121
          BEGIN
122
               IF EQUAL(3,3) THEN
123
                    RETURN I;
124
               ELSE
125
                    RETURN PRIVY'(0);
126
               END IF;
127
          END IDENT;
128
 
129
          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
130
          BEGIN
131
               RETURN I+1;
132
          END NEXT;
133
     END PACK1;
134
 
135
     PACKAGE BODY GENERIC1 IS
136
          XRI1 : INTEGER RENAMES REC.RI1;
137
          XRA1 : ARRAY1 RENAMES REC.RA1;
138
          XRR1 : RECORD1 RENAMES REC.RR1;
139
          XRP1 : POINTER1 RENAMES REC.RP1;
140
          XRV1 : PACK1.PRIVY RENAMES REC.RV1;
141
          XRT1 : TASK1 RENAMES REC.RT1;
142
          XAI1 : ARR_INT RENAMES AI1(1..3);
143
          XAA1 : ARR_ARR RENAMES AA1(2..4);
144
          XAR1 : ARR_REC RENAMES AR1(3..5);
145
          XAP1 : ARR_PTR RENAMES AP1(4..6);
146
          XAV1 : ARR_PVT RENAMES AV1(5..7);
147
          XAT1 : ARR_TSK RENAMES AT1(6..8);
148
 
149
          TASK TYPE TASK2 IS
150
               ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
151
                             TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
152
                             TRV1 : IN OUT PACK1.PRIVY;
153
                             TRT1 : IN OUT TASK1;
154
                             TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
155
                             TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
156
                             TAV1 : IN OUT ARR_PVT;
157
                             TAT1 : IN OUT ARR_TSK);
158
          END TASK2;
159
 
160
          CHK_TASK : TASK2;
161
          I : INTEGER;
162
 
163
          GENERIC
164
               GRI1 : IN OUT INTEGER;
165
               GRA1 : IN OUT ARRAY1;
166
               GRR1 : IN OUT RECORD1;
167
               GRP1 : IN OUT POINTER1;
168
               GRV1 : IN OUT PACK1.PRIVY;
169
               GRT1 : IN OUT TASK1;
170
               GAI1 : IN OUT ARR_INT;
171
               GAA1 : IN OUT ARR_ARR;
172
               GAR1 : IN OUT ARR_REC;
173
               GAP1 : IN OUT ARR_PTR;
174
               GAV1 : IN OUT ARR_PVT;
175
               GAT1 : IN OUT ARR_TSK;
176
          PACKAGE GENERIC2 IS
177
          END GENERIC2;
178
 
179
          PACKAGE BODY GENERIC2 IS
180
          BEGIN
181
               GRI1 := GRI1 + 1;
182
               GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
183
               GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
184
               GRP1 := NEW INTEGER'(GRP1.ALL + 1);
185
               GRV1 := PACK1.NEXT(GRV1);
186
               GRT1.NEXT;
187
               GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
188
               GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
189
               GAR1 := (OTHERS => (D => 1,
190
                              FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
191
               GAP1 := (OTHERS =>
192
                         NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
193
               FOR J IN GAV1'RANGE LOOP
194
                    GAV1(J) := PACK1.NEXT(GAV1(J));
195
               END LOOP;
196
               FOR J IN GAT1'RANGE LOOP
197
                    GAT1(J).NEXT;
198
               END LOOP;
199
          END GENERIC2;
200
 
201
          PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
202
                           PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
203
                           PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
204
                           PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
205
                           PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
206
                           PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
207
          BEGIN
208
               PRI1 := PRI1 + 1;
209
               PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
210
               PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
211
               PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
212
               PRV1 := PACK1.NEXT(REC.RV1);
213
               PRT1.NEXT;
214
               PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
215
               PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
216
               PAR1 := (OTHERS => (D => 1, FIELD1 =>
217
                                   (PAR1(PAR1'FIRST).FIELD1 + 1)));
218
               PAP1 := (OTHERS =>
219
                        NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
220
               FOR J IN PAV1'RANGE LOOP
221
                    PAV1(J) := PACK1.NEXT(AV1(J));
222
               END LOOP;
223
               FOR J IN PAT1'RANGE LOOP
224
                    PAT1(J).NEXT;
225
               END LOOP;
226
          END PROC1;
227
 
228
          TASK BODY TASK2 IS
229
          BEGIN
230
               ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
231
                              TRR1 : OUT RECORD1;
232
                              TRP1 : IN OUT POINTER1;
233
                              TRV1 : IN OUT PACK1.PRIVY;
234
                              TRT1: IN OUT TASK1;
235
                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
236
                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
237
                              TAV1 : IN OUT ARR_PVT;
238
                              TAT1 : IN OUT ARR_TSK)
239
               DO
240
                    TRI1 := REC.RI1 + 1;
241
                    TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
242
                    TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
243
                    TRP1 := NEW INTEGER'(TRP1.ALL + 1);
244
                    TRV1 := PACK1.NEXT(TRV1);
245
                    TRT1.NEXT;
246
                    TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
247
                    TAA1 := (OTHERS => (OTHERS =>
248
                                        AA1(TAA1'FIRST)(1) + 1));
249
                    TAR1 := (OTHERS => (D => 1, FIELD1 =>
250
                                        (AR1(TAR1'FIRST).FIELD1 + 1)));
251
                    TAP1 := (OTHERS =>
252
                             NEW INTEGER'(TAP1(TAP1'FIRST).ALL + 1));
253
                    FOR J IN TAV1'RANGE LOOP
254
                         TAV1(J) := PACK1.NEXT(TAV1(J));
255
                    END LOOP;
256
                    FOR J IN TAT1'RANGE LOOP
257
                         TAT1(J).NEXT;
258
                    END LOOP;
259
               END ENTRY1;
260
          END TASK2;
261
 
262
          PACKAGE GENPACK2 IS NEW
263
               GENERIC2 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
264
                         XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
265
 
266
     BEGIN
267
          IF XRI1 /= IDENT_INT(1) THEN
268
               FAILED ("INCORRECT VALUE OF XRI1 (1)");
269
          END IF;
270
 
271
          IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
272
               FAILED ("INCORRECT VALUE OF XRA1 (1)");
273
          END IF;
274
 
275
          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
276
               FAILED ("INCORRECT VALUE OF XRR1 (1)");
277
          END IF;
278
 
279
          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
280
               FAILED ("INCORRECT VALUE OF XRP1 (1)");
281
          END IF;
282
 
283
          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
284
               FAILED ("INCORRECT VALUE OF XRV1 (1)");
285
          END IF;
286
 
287
          XRT1.VALU(I);
288
          IF I /= IDENT_INT(1) THEN
289
               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
290
          END IF;
291
 
292
          FOR J IN XAI1'RANGE LOOP
293
               IF XAI1(J) /= IDENT_INT(1) THEN
294
                    FAILED ("INCORRECT VALUE OF XAI1(" &
295
                            INTEGER'IMAGE(J) & ") (1)");
296
               END IF;
297
          END LOOP;
298
 
299
          FOR J IN XAA1'RANGE LOOP
300
               IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
301
               THEN
302
                    FAILED ("INCORRECT VALUE OF XAA1(" &
303
                            INTEGER'IMAGE(J) & ") (1)");
304
               END IF;
305
          END LOOP;
306
 
307
          FOR J IN XAR1'RANGE LOOP
308
               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
309
                    FAILED ("INCORRECT VALUE OF XAR1(" &
310
                            INTEGER'IMAGE(J) & ") (1)");
311
               END IF;
312
          END LOOP;
313
 
314
          FOR J IN XAP1'RANGE LOOP
315
               IF XAP1(J) /= IDENT(AP1(J)) OR
316
                  XAP1(J).ALL /= IDENT_INT(1)
317
               THEN
318
                    FAILED ("INCORRECT VALUE OF XAP1(" &
319
                            INTEGER'IMAGE(J) & ") (1)");
320
               END IF;
321
          END LOOP;
322
 
323
          FOR J IN XAV1'RANGE LOOP
324
               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
325
                    FAILED ("INCORRECT VALUE OF XAV1(" &
326
                            INTEGER'IMAGE(J) & ") (1)");
327
               END IF;
328
          END LOOP;
329
 
330
          FOR J IN XAT1'RANGE LOOP
331
               XAT1(J).VALU(I);
332
               IF I /= IDENT_INT(1) THEN
333
                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
334
                            INTEGER'IMAGE(J) & ").VALU (1)");
335
               END IF;
336
          END LOOP;
337
 
338
          PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
339
                 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
340
 
341
          IF XRI1 /= IDENT_INT(2) THEN
342
               FAILED ("INCORRECT VALUE OF XRI1 (2)");
343
          END IF;
344
 
345
          IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
346
               FAILED ("INCORRECT VALUE OF XRA1 (2)");
347
          END IF;
348
 
349
          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
350
               FAILED ("INCORRECT VALUE OF XRR1 (2)");
351
          END IF;
352
 
353
          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
354
               FAILED ("INCORRECT VALUE OF XRP1 (2)");
355
          END IF;
356
 
357
          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
358
               FAILED ("INCORRECT VALUE OF XRV1 (2)");
359
          END IF;
360
 
361
          XRT1.VALU(I);
362
          IF I /= IDENT_INT(2) THEN
363
               FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
364
          END IF;
365
 
366
          FOR J IN XAI1'RANGE LOOP
367
               IF XAI1(J) /= IDENT_INT(2) THEN
368
                    FAILED ("INCORRECT VALUE OF XAI1(" &
369
                            INTEGER'IMAGE(J) & ") (2)");
370
               END IF;
371
          END LOOP;
372
 
373
          FOR J IN XAA1'RANGE LOOP
374
               IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
375
               THEN
376
                    FAILED ("INCORRECT VALUE OF XAA1(" &
377
                            INTEGER'IMAGE(J) & ") (2)");
378
               END IF;
379
          END LOOP;
380
 
381
          FOR J IN XAR1'RANGE LOOP
382
               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
383
                    FAILED ("INCORRECT VALUE OF XAR1(" &
384
                            INTEGER'IMAGE(J) & ") (2)");
385
               END IF;
386
          END LOOP;
387
 
388
          FOR J IN XAP1'RANGE LOOP
389
               IF XAP1(J) /= IDENT(AP1(J)) OR
390
                  XAP1(J).ALL /= IDENT_INT(2) THEN
391
                    FAILED ("INCORRECT VALUE OF XAP1(" &
392
                            INTEGER'IMAGE(J) & ") (2)");
393
               END IF;
394
          END LOOP;
395
 
396
          FOR J IN XAV1'RANGE LOOP
397
               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
398
                    FAILED ("INCORRECT VALUE OF XAV1(" &
399
                            INTEGER'IMAGE(J) & ") (2)");
400
               END IF;
401
          END LOOP;
402
 
403
          FOR J IN XAT1'RANGE LOOP
404
               XAT1(J).VALU(I);
405
               IF I /= IDENT_INT(2) THEN
406
                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
407
                            INTEGER'IMAGE(J) & ").VALU (2)");
408
               END IF;
409
          END LOOP;
410
 
411
          CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
412
                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
413
 
414
          IF XRI1 /= IDENT_INT(3) THEN
415
               FAILED ("INCORRECT VALUE OF XRI1 (3)");
416
          END IF;
417
 
418
          IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
419
               FAILED ("INCORRECT VALUE OF XRA1 (3)");
420
          END IF;
421
 
422
          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
423
               FAILED ("INCORRECT VALUE OF XRR1 (3)");
424
          END IF;
425
 
426
          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
427
               FAILED ("INCORRECT VALUE OF XRP1 (3)");
428
          END IF;
429
 
430
          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
431
               FAILED ("INCORRECT VALUE OF XRV1 (3)");
432
          END IF;
433
 
434
          XRT1.VALU(I);
435
          IF I /= IDENT_INT(3) THEN
436
               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
437
          END IF;
438
 
439
          FOR J IN XAI1'RANGE LOOP
440
               IF XAI1(J) /= IDENT_INT(3) THEN
441
                    FAILED ("INCORRECT VALUE OF XAI1(" &
442
                            INTEGER'IMAGE(J) & ") (3)");
443
               END IF;
444
          END LOOP;
445
 
446
          FOR J IN XAA1'RANGE LOOP
447
               IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
448
               THEN
449
                    FAILED ("INCORRECT VALUE OF XAA1(" &
450
                            INTEGER'IMAGE(J) & ") (3)");
451
               END IF;
452
          END LOOP;
453
 
454
          FOR J IN XAR1'RANGE LOOP
455
               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
456
                    FAILED ("INCORRECT VALUE OF XAR1(" &
457
                            INTEGER'IMAGE(J) & ") (3)");
458
               END IF;
459
          END LOOP;
460
 
461
          FOR J IN XAP1'RANGE LOOP
462
               IF XAP1(J) /= IDENT(AP1(J)) OR
463
                  XAP1(J).ALL /= IDENT_INT(3) THEN
464
                    FAILED ("INCORRECT VALUE OF XAP1(" &
465
                            INTEGER'IMAGE(J) & ") (3)");
466
               END IF;
467
          END LOOP;
468
 
469
          FOR J IN XAV1'RANGE LOOP
470
               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
471
                    FAILED ("INCORRECT VALUE OF XAV1(" &
472
                            INTEGER'IMAGE(J) & ") (3)");
473
               END IF;
474
          END LOOP;
475
 
476
          FOR J IN XAT1'RANGE LOOP
477
               XAT1(J).VALU(I);
478
               IF I /= IDENT_INT(3) THEN
479
                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
480
                            INTEGER'IMAGE(J) & ").VALU (3)");
481
               END IF;
482
          END LOOP;
483
 
484
          XRI1 := XRI1 + 1;
485
          XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
486
          XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
487
          XRP1 := NEW INTEGER'(XRP1.ALL + 1);
488
          XRV1 := PACK1.NEXT(XRV1);
489
          XRT1.NEXT;
490
          XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
491
          XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
492
          XAR1 := (OTHERS => (D => 1,
493
                         FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
494
          XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
495
          FOR J IN XAV1'RANGE LOOP
496
               XAV1(J) := PACK1.NEXT(XAV1(J));
497
          END LOOP;
498
          FOR J IN XAT1'RANGE LOOP
499
               XAT1(J).NEXT;
500
          END LOOP;
501
 
502
          IF XRI1 /= IDENT_INT(4) THEN
503
               FAILED ("INCORRECT VALUE OF XRI1 (4)");
504
          END IF;
505
 
506
          IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
507
               FAILED ("INCORRECT VALUE OF XRA1 (4)");
508
          END IF;
509
 
510
          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
511
               FAILED ("INCORRECT VALUE OF XRR1 (4)");
512
          END IF;
513
 
514
          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
515
               FAILED ("INCORRECT VALUE OF XRP1 (4)");
516
          END IF;
517
 
518
          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
519
               FAILED ("INCORRECT VALUE OF XRV1 (4)");
520
          END IF;
521
 
522
          XRT1.VALU(I);
523
          IF I /= IDENT_INT(4) THEN
524
               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
525
          END IF;
526
 
527
          FOR J IN XAI1'RANGE LOOP
528
               IF XAI1(J) /= IDENT_INT(4) THEN
529
                    FAILED ("INCORRECT VALUE OF XAI1(" &
530
                            INTEGER'IMAGE(J) & ") (4)");
531
               END IF;
532
          END LOOP;
533
 
534
          FOR J IN XAA1'RANGE LOOP
535
               IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
536
               THEN
537
                    FAILED ("INCORRECT VALUE OF XAA1(" &
538
                            INTEGER'IMAGE(J) & ") (4)");
539
               END IF;
540
          END LOOP;
541
 
542
          FOR J IN XAR1'RANGE LOOP
543
               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
544
                    FAILED ("INCORRECT VALUE OF XAR1(" &
545
                            INTEGER'IMAGE(J) & ") (4)");
546
               END IF;
547
          END LOOP;
548
 
549
          FOR J IN XAP1'RANGE LOOP
550
               IF XAP1(J) /= IDENT(AP1(J)) OR
551
                  XAP1(J).ALL /= IDENT_INT(4) THEN
552
                    FAILED ("INCORRECT VALUE OF XAP1(" &
553
                            INTEGER'IMAGE(J) & ") (4)");
554
               END IF;
555
          END LOOP;
556
 
557
          FOR J IN XAV1'RANGE LOOP
558
               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
559
                    FAILED ("INCORRECT VALUE OF XAV1(" &
560
                            INTEGER'IMAGE(J) & ") (4)");
561
               END IF;
562
          END LOOP;
563
 
564
          FOR J IN XAT1'RANGE LOOP
565
               XAT1(J).VALU(I);
566
               IF I /= IDENT_INT(4) THEN
567
                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
568
                            INTEGER'IMAGE(J) & ").VALU (4)");
569
               END IF;
570
          END LOOP;
571
 
572
          REC.RI1 := REC.RI1 + 1;
573
          REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
574
          REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
575
          REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
576
          REC.RV1 := PACK1.NEXT(REC.RV1);
577
          REC.RT1.NEXT;
578
          AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
579
          AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
580
          AR1 := (OTHERS => (D => 1,
581
                             FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
582
          AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
583
          FOR J IN XAV1'RANGE LOOP
584
               AV1(J) := PACK1.NEXT(AV1(J));
585
          END LOOP;
586
          FOR J IN XAT1'RANGE LOOP
587
               AT1(J).NEXT;
588
          END LOOP;
589
 
590
          IF XRI1 /= IDENT_INT(5) THEN
591
               FAILED ("INCORRECT VALUE OF XRI1 (5)");
592
          END IF;
593
 
594
          IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
595
               FAILED ("INCORRECT VALUE OF XRA1 (5)");
596
          END IF;
597
 
598
          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
599
               FAILED ("INCORRECT VALUE OF XRR1 (5)");
600
          END IF;
601
 
602
          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
603
               FAILED ("INCORRECT VALUE OF XRP1 (5)");
604
          END IF;
605
 
606
          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
607
               FAILED ("INCORRECT VALUE OF XRV1 (5)");
608
          END IF;
609
 
610
          XRT1.VALU(I);
611
          IF I /= IDENT_INT(5) THEN
612
               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
613
          END IF;
614
 
615
          FOR J IN XAI1'RANGE LOOP
616
               IF XAI1(J) /= IDENT_INT(5) THEN
617
                    FAILED ("INCORRECT VALUE OF XAI1(" &
618
                            INTEGER'IMAGE(J) & ") (5)");
619
               END IF;
620
          END LOOP;
621
 
622
          FOR J IN XAA1'RANGE LOOP
623
               IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
624
               THEN
625
                    FAILED ("INCORRECT VALUE OF XAA1(" &
626
                            INTEGER'IMAGE(J) & ") (5)");
627
               END IF;
628
          END LOOP;
629
 
630
          FOR J IN XAR1'RANGE LOOP
631
               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
632
                    FAILED ("INCORRECT VALUE OF XAR1(" &
633
                            INTEGER'IMAGE(J) & ") (5)");
634
               END IF;
635
          END LOOP;
636
 
637
          FOR J IN XAP1'RANGE LOOP
638
               IF XAP1(J) /= IDENT(AP1(J)) OR
639
               XAP1(J).ALL /= IDENT_INT(5) THEN
640
                    FAILED ("INCORRECT VALUE OF XAP1(" &
641
                            INTEGER'IMAGE(J) & ") (5)");
642
               END IF;
643
          END LOOP;
644
 
645
          FOR J IN XAV1'RANGE LOOP
646
               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
647
                    FAILED ("INCORRECT VALUE OF XAV1(" &
648
                            INTEGER'IMAGE(J) & ") (5)");
649
               END IF;
650
          END LOOP;
651
 
652
          FOR J IN XAT1'RANGE LOOP
653
               XAT1(J).VALU(I);
654
               IF I /= IDENT_INT(5) THEN
655
                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
656
                            INTEGER'IMAGE(J) & ").VALU (5)");
657
               END IF;
658
          END LOOP;
659
     END GENERIC1;
660
 
661
     TASK BODY TASK1 IS
662
          TASK_VALUE : INTEGER := 0;
663
          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
664
     BEGIN
665
          WHILE ACCEPTING_ENTRIES LOOP
666
               SELECT
667
                    ACCEPT ASSIGN (J : IN INTEGER) DO
668
                         TASK_VALUE := J;
669
                    END ASSIGN;
670
               OR
671
                    ACCEPT VALU (J : OUT INTEGER) DO
672
                         J := TASK_VALUE;
673
                    END VALU;
674
               OR
675
                    ACCEPT NEXT DO
676
                         TASK_VALUE := TASK_VALUE + 1;
677
                    END NEXT;
678
               OR
679
                    ACCEPT STOP DO
680
                         ACCEPTING_ENTRIES := FALSE;
681
                    END STOP;
682
               END SELECT;
683
          END LOOP;
684
     END TASK1;
685
 
686
BEGIN
687
     TEST ("C85006D", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
688
                      "CREATED BY A GENERIC 'IN OUT' FORMAL " &
689
                      "PARAMETER CAN BE RENAMED AND HAS THE CORRECT " &
690
                      "VALUE, AND THAT THE NEW NAME CAN BE USED IN " &
691
                      "AN ASSIGNMENT STATEMENT AND PASSED ON AS AN " &
692
                      "ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
693
                      "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
694
                      "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
695
                      "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
696
                      "REFLECTED BY THE VALUE OF THE NEW NAME");
697
 
698
     DECLARE
699
          PACKAGE GENPACK IS NEW
700
               GENERIC1 (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
701
     BEGIN
702
          NULL;
703
     END;
704
 
705
     DREC.RT1.STOP;
706
 
707
     FOR I IN DAT1'RANGE LOOP
708
          DAT1(I).STOP;
709
     END LOOP;
710
 
711
     RESULT;
712
END C85006D;

powered by: WebSVN 2.1.0

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