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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c85006d.ada] - Blame information for rev 316

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 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.