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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C85005C.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 VARIABLE CREATED BY AN ENTRY 'IN OUT' FORMAL
27
--     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT
28
--     THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED
29
--     ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,
30
--     AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE
31
--     VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS
32
--     REFLECTED BY THE VALUE OF THE NEW NAME.
33
 
34
-- HISTORY:
35
--     JET 03/15/88  CREATED ORIGINAL TEST.
36
 
37
WITH REPORT; USE REPORT;
38
PROCEDURE C85005C 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
     DI1 : INTEGER := 0;
75
     DA1 : ARRAY1(1..3) := (OTHERS => 0);
76
     DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
77
     DP1 : POINTER1 := NEW INTEGER'(0);
78
     DV1 : PACK1.PRIVY := PACK1.ZERO;
79
     DT1 : TASK1;
80
 
81
     I : INTEGER;
82
 
83
     GENERIC
84
          GI1 : IN OUT INTEGER;
85
          GA1 : IN OUT ARRAY1;
86
          GR1 : IN OUT RECORD1;
87
          GP1 : IN OUT POINTER1;
88
          GV1 : IN OUT PACK1.PRIVY;
89
          GT1 : IN OUT TASK1;
90
     PACKAGE GENERIC1 IS
91
     END GENERIC1;
92
 
93
     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
94
     BEGIN
95
          IF EQUAL (3,3) THEN
96
               RETURN P;
97
          ELSE
98
               RETURN NULL;
99
          END IF;
100
     END IDENT;
101
 
102
     PACKAGE BODY PACK1 IS
103
          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
104
          BEGIN
105
               IF EQUAL(3,3) THEN
106
                    RETURN I;
107
               ELSE
108
                    RETURN PRIVY'(0);
109
               END IF;
110
          END IDENT;
111
 
112
          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
113
          BEGIN
114
               RETURN I+1;
115
          END NEXT;
116
     END PACK1;
117
 
118
     PACKAGE BODY GENERIC1 IS
119
     BEGIN
120
          GI1 := GI1 + 1;
121
          GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
122
          GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
123
          GP1 := NEW INTEGER'(GP1.ALL + 1);
124
          GV1 := PACK1.NEXT(GV1);
125
          GT1.NEXT;
126
     END GENERIC1;
127
 
128
     TASK BODY TASK1 IS
129
          TASK_VALUE : INTEGER := 0;
130
          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
131
     BEGIN
132
          WHILE ACCEPTING_ENTRIES LOOP
133
               SELECT
134
                    ACCEPT ASSIGN (J : IN INTEGER) DO
135
                         TASK_VALUE := J;
136
                    END ASSIGN;
137
               OR
138
                    ACCEPT VALU (J : OUT INTEGER) DO
139
                         J := TASK_VALUE;
140
                    END VALU;
141
               OR
142
                    ACCEPT NEXT DO
143
                         TASK_VALUE := TASK_VALUE + 1;
144
                    END NEXT;
145
               OR
146
                    ACCEPT STOP DO
147
                         ACCEPTING_ENTRIES := FALSE;
148
                    END STOP;
149
               END SELECT;
150
          END LOOP;
151
     END TASK1;
152
 
153
BEGIN
154
     TEST ("C85005C", "CHECK THAT A VARIABLE CREATED BY AN ENTRY " &
155
                      "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
156
                      "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
157
                      "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
158
                      "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
159
                      "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
160
                      "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
161
                      "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
162
                      "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
163
                      "VALUE OF THE NEW NAME");
164
 
165
     DECLARE
166
          TASK MAIN_TASK IS
167
               ENTRY START (TI1 : IN OUT INTEGER; TA1 : IN OUT ARRAY1;
168
                            TR1 : IN OUT RECORD1; TP1 : IN OUT POINTER1;
169
                            TV1 : IN OUT PACK1.PRIVY;
170
                            TT1 : IN OUT TASK1);
171
          END MAIN_TASK;
172
 
173
          TASK BODY MAIN_TASK IS
174
          BEGIN
175
               ACCEPT START (TI1: IN OUT INTEGER; TA1: IN OUT ARRAY1;
176
                             TR1: IN OUT RECORD1; TP1: IN OUT POINTER1;
177
                             TV1: IN OUT PACK1.PRIVY;
178
                             TT1: IN OUT TASK1) DO
179
                    DECLARE
180
                         XTI1 : INTEGER RENAMES TI1;
181
                         XTA1 : ARRAY1 RENAMES TA1;
182
                         XTR1 : RECORD1 RENAMES TR1;
183
                         XTP1 : POINTER1 RENAMES TP1;
184
                         XTV1 : PACK1.PRIVY RENAMES TV1;
185
                         XTT1 : TASK1 RENAMES TT1;
186
 
187
                         TASK TYPE TASK2 IS
188
                              ENTRY ENTRY1 (TTI1 : OUT INTEGER;
189
                                            TTA1 : OUT ARRAY1;
190
                                            TTR1 : OUT RECORD1;
191
                                            TTP1 : IN OUT POINTER1;
192
                                            TTV1 : IN OUT PACK1.PRIVY;
193
                                            TTT1 : IN OUT TASK1);
194
                         END TASK2;
195
 
196
                         CHK_TASK : TASK2;
197
 
198
                         PROCEDURE PROC1 (PTI1 : IN OUT INTEGER;
199
                                          PTA1 : IN OUT ARRAY1;
200
                                          PTR1 : IN OUT RECORD1;
201
                                          PTP1 : OUT POINTER1;
202
                                          PTV1 : OUT PACK1.PRIVY;
203
                                          PTT1 : IN OUT TASK1) IS
204
                         BEGIN
205
                              PTI1 := PTI1 + 1;
206
                              PTA1 := (PTA1(1)+1, PTA1(2)+1, PTA1(3)+1);
207
                              PTR1 := (D => 1,
208
                                       FIELD1 => PTR1.FIELD1 + 1);
209
                              PTP1 := NEW INTEGER'(TP1.ALL + 1);
210
                              PTV1 := PACK1.NEXT(TV1);
211
                              PTT1.NEXT;
212
                         END PROC1;
213
 
214
                         TASK BODY TASK2 IS
215
                         BEGIN
216
                              ACCEPT ENTRY1 (TTI1 : OUT INTEGER;
217
                                             TTA1 : OUT ARRAY1;
218
                                             TTR1 : OUT RECORD1;
219
                                             TTP1 : IN OUT POINTER1;
220
                                             TTV1 : IN OUT PACK1.PRIVY;
221
                                             TTT1 : IN OUT TASK1)
222
                              DO
223
                                   TTI1 := TI1 + 1;
224
                                   TTA1 := (TA1(1)+1,
225
                                   TA1(2)+1, TA1(3)+1);
226
                                   TTR1 := (D => 1,
227
                                            FIELD1 => TR1.FIELD1 + 1);
228
                                   TTP1 := NEW INTEGER'(TTP1.ALL + 1);
229
                                   TTV1 := PACK1.NEXT(TTV1);
230
                                   TTT1.NEXT;
231
                              END ENTRY1;
232
                         END TASK2;
233
 
234
                         PACKAGE GENPACK1 IS NEW GENERIC1
235
                              (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
236
                    BEGIN
237
                         IF XTI1 /= IDENT_INT(1) THEN
238
                              FAILED ("INCORRECT VALUE OF XTI1 (1)");
239
                         END IF;
240
 
241
                         IF XTA1 /= (IDENT_INT(1),IDENT_INT(1),
242
                                     IDENT_INT(1)) THEN
243
                              FAILED ("INCORRECT VALUE OF XTA1 (1)");
244
                         END IF;
245
 
246
                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(1))
247
                         THEN
248
                              FAILED ("INCORRECT VALUE OF XTR1 (1)");
249
                         END IF;
250
 
251
                         IF XTP1 /= IDENT(TP1) OR
252
                            XTP1.ALL /= IDENT_INT(1) THEN
253
                              FAILED ("INCORRECT VALUE OF XTP1 (1)");
254
                         END IF;
255
 
256
                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.ONE))
257
                         THEN
258
                              FAILED ("INCORRECT VALUE OF XTV1 (1)");
259
                         END IF;
260
 
261
                         XTT1.VALU(I);
262
                         IF I /= IDENT_INT(1) THEN
263
                              FAILED ("INCORRECT RETURN VALUE OF " &
264
                                      "XTT1.VALU (1)");
265
                         END IF;
266
 
267
                         PROC1(XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
268
 
269
                         IF XTI1 /= IDENT_INT(2) THEN
270
                              FAILED ("INCORRECT VALUE OF XTI1 (2)");
271
                         END IF;
272
 
273
                         IF XTA1 /= (IDENT_INT(2),IDENT_INT(2),
274
                                     IDENT_INT(2)) THEN
275
                              FAILED ("INCORRECT VALUE OF XTA1 (2)");
276
                         END IF;
277
 
278
                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(2))
279
                         THEN
280
                              FAILED ("INCORRECT VALUE OF XTR1 (2)");
281
                         END IF;
282
 
283
                         IF XTP1 /= IDENT(TP1) OR
284
                            XTP1.ALL /= IDENT_INT(2) THEN
285
                              FAILED ("INCORRECT VALUE OF XTP1 (2)");
286
                         END IF;
287
 
288
                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.TWO))
289
                         THEN
290
                              FAILED ("INCORRECT VALUE OF XTV1 (2)");
291
                         END IF;
292
 
293
                         XTT1.VALU(I);
294
                         IF I /= IDENT_INT(2) THEN
295
                              FAILED ("INCORRECT RETURN VALUE FROM " &
296
                                      "XTT1.VALU (2)");
297
                         END IF;
298
 
299
                         CHK_TASK.ENTRY1
300
                              (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
301
 
302
                         IF XTI1 /= IDENT_INT(3) THEN
303
                              FAILED ("INCORRECT VALUE OF XTI1 (3)");
304
                         END IF;
305
 
306
                         IF XTA1 /= (IDENT_INT(3),IDENT_INT(3),
307
                                     IDENT_INT(3)) THEN
308
                              FAILED ("INCORRECT VALUE OF XTA1 (3)");
309
                         END IF;
310
 
311
                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(3))
312
                         THEN
313
                              FAILED ("INCORRECT VALUE OF XTR1 (3)");
314
                         END IF;
315
 
316
                         IF XTP1 /= IDENT(TP1) OR
317
                            XTP1.ALL /= IDENT_INT(3) THEN
318
                              FAILED ("INCORRECT VALUE OF XTP1 (3)");
319
                         END IF;
320
 
321
                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.THREE))
322
                         THEN
323
                              FAILED ("INCORRECT VALUE OF XTV1 (3)");
324
                         END IF;
325
 
326
                         XTT1.VALU(I);
327
                         IF I /= IDENT_INT(3) THEN
328
                              FAILED ("INCORRECT RETURN VALUE OF " &
329
                                      "XTT1.VALU (3)");
330
                         END IF;
331
 
332
                         XTI1 := XTI1 + 1;
333
                         XTA1 := (XTA1(1)+1, XTA1(2)+1, XTA1(3)+1);
334
                         XTR1 := (D => 1, FIELD1 => XTR1.FIELD1 + 1);
335
                         XTP1 := NEW INTEGER'(XTP1.ALL + 1);
336
                         XTV1 := PACK1.NEXT(XTV1);
337
                         XTT1.NEXT;
338
 
339
                         IF XTI1 /= IDENT_INT(4) THEN
340
                              FAILED ("INCORRECT VALUE OF XTI1 (4)");
341
                         END IF;
342
 
343
                         IF XTA1 /= (IDENT_INT(4),IDENT_INT(4),
344
                                     IDENT_INT(4)) THEN
345
                              FAILED ("INCORRECT VALUE OF XTA1 (4)");
346
                         END IF;
347
 
348
                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(4))
349
                         THEN
350
                              FAILED ("INCORRECT VALUE OF XTR1 (4)");
351
                         END IF;
352
 
353
                         IF XTP1 /= IDENT(TP1) OR
354
                            XTP1.ALL /= IDENT_INT(4) THEN
355
                              FAILED ("INCORRECT VALUE OF XTP1 (4)");
356
                         END IF;
357
 
358
                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FOUR))
359
                         THEN
360
                              FAILED ("INCORRECT VALUE OF XTV1 (4)");
361
                         END IF;
362
 
363
                         XTT1.VALU(I);
364
                         IF I /= IDENT_INT(4) THEN
365
                              FAILED ("INCORRECT RETURN VALUE OF " &
366
                                      "XTT1.VALU (4)");
367
                         END IF;
368
 
369
                         TI1 := TI1 + 1;
370
                         TA1 := (TA1(1)+1, TA1(2)+1, TA1(3)+1);
371
                         TR1 := (D => 1, FIELD1 => TR1.FIELD1 + 1);
372
                         TP1 := NEW INTEGER'(TP1.ALL + 1);
373
                         TV1 := PACK1.NEXT(TV1);
374
                         TT1.NEXT;
375
 
376
                         IF XTI1 /= IDENT_INT(5) THEN
377
                              FAILED ("INCORRECT VALUE OF XTI1 (5)");
378
                         END IF;
379
 
380
                         IF XTA1 /= (IDENT_INT(5),IDENT_INT(5),
381
                                     IDENT_INT(5)) THEN
382
                              FAILED ("INCORRECT VALUE OF XTA1 (5)");
383
                         END IF;
384
 
385
                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(5))
386
                         THEN
387
                              FAILED ("INCORRECT VALUE OF XTR1 (5)");
388
                         END IF;
389
 
390
                         IF XTP1 /= IDENT(TP1) OR
391
                            XTP1.ALL /= IDENT_INT(5) THEN
392
                              FAILED ("INCORRECT VALUE OF XTP1 (5)");
393
                         END IF;
394
 
395
                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FIVE))
396
                         THEN
397
                              FAILED ("INCORRECT VALUE OF XTV1 (5)");
398
                         END IF;
399
 
400
                         XTT1.VALU(I);
401
                         IF I /= IDENT_INT(5) THEN
402
                              FAILED ("INCORRECT RETURN VALUE OF " &
403
                                      "XTT1.VALU (5)");
404
                         END IF;
405
                    END;
406
               END START;
407
          END MAIN_TASK;
408
 
409
     BEGIN
410
          MAIN_TASK.START (DI1, DA1, DR1, DP1, DV1, DT1);
411
     END;
412
 
413
     DT1.STOP;
414
 
415
     RESULT;
416
END C85005C;

powered by: WebSVN 2.1.0

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