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/] [c85005a.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C85005A.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 OBJECT DECLARATION CAN BE
27
--     RENAMED AND HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN
28
--     BE USED IN AN ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL
29
--     SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN
30
--     ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF
31
--     THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED
32
--     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 C85005A 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
          K1 : INTEGER := 0;
49
          TYPE PRIVY IS PRIVATE;
50
          ZERO : CONSTANT PRIVY;
51
          ONE : CONSTANT PRIVY;
52
          TWO : CONSTANT PRIVY;
53
          THREE : CONSTANT PRIVY;
54
          FOUR : CONSTANT PRIVY;
55
          FIVE : CONSTANT PRIVY;
56
          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
57
          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
58
     PRIVATE
59
          TYPE PRIVY IS RANGE 0..127;
60
          ZERO : CONSTANT PRIVY := 0;
61
          ONE : CONSTANT PRIVY := 1;
62
          TWO : CONSTANT PRIVY := 2;
63
          THREE : CONSTANT PRIVY := 3;
64
          FOUR : CONSTANT PRIVY := 4;
65
          FIVE : CONSTANT PRIVY := 5;
66
     END PACK1;
67
 
68
     TASK TYPE TASK1 IS
69
          ENTRY ASSIGN (J : IN INTEGER);
70
          ENTRY VALU (J : OUT INTEGER);
71
          ENTRY NEXT;
72
          ENTRY STOP;
73
     END TASK1;
74
 
75
     TASK TYPE TASK2 IS
76
          ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
77
                        TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
78
                        TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
79
                        TK1 : IN OUT INTEGER);
80
     END TASK2;
81
 
82
     I1 : INTEGER := 0;
83
     A1 : ARRAY1(1..3) := (OTHERS => 0);
84
     R1 : RECORD1(1) := (D => 1, FIELD1 => 0);
85
     P1 : POINTER1 := NEW INTEGER'(0);
86
     V1 : PACK1.PRIVY := PACK1.ZERO;
87
     T1 : TASK1;
88
 
89
     XI1 : INTEGER RENAMES I1;
90
     XA1 : ARRAY1 RENAMES A1;
91
     XR1 : RECORD1 RENAMES R1;
92
     XP1 : POINTER1 RENAMES P1;
93
     XV1 : PACK1.PRIVY RENAMES V1;
94
     XT1 : TASK1 RENAMES T1;
95
     XK1 : INTEGER RENAMES PACK1.K1;
96
 
97
     I : INTEGER;
98
     CHK_TASK : TASK2;
99
 
100
     GENERIC
101
          GI1 : IN OUT INTEGER;
102
          GA1 : IN OUT ARRAY1;
103
          GR1 : IN OUT RECORD1;
104
          GP1 : IN OUT POINTER1;
105
          GV1 : IN OUT PACK1.PRIVY;
106
          GT1 : IN OUT TASK1;
107
          GK1 : IN OUT INTEGER;
108
     PACKAGE GENERIC1 IS
109
     END GENERIC1;
110
 
111
     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
112
     BEGIN
113
          IF EQUAL (3,3) THEN
114
               RETURN P;
115
          ELSE
116
               RETURN NULL;
117
          END IF;
118
     END IDENT;
119
 
120
     PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
121
                      PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
122
                      PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
123
                      PK1 : OUT INTEGER) IS
124
 
125
     BEGIN
126
          PI1 := PI1 + 1;
127
          PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
128
          PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
129
          PP1 := NEW INTEGER'(P1.ALL + 1);
130
          PV1 := PACK1.NEXT(V1);
131
          PT1.NEXT;
132
          PK1 := PACK1.K1 + 1;
133
     END PROC1;
134
 
135
     PACKAGE BODY PACK1 IS
136
          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
137
          BEGIN
138
               IF EQUAL(3,3) THEN
139
                    RETURN I;
140
               ELSE
141
                    RETURN PRIVY'(0);
142
               END IF;
143
          END IDENT;
144
 
145
          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
146
          BEGIN
147
               RETURN I+1;
148
          END NEXT;
149
     END PACK1;
150
 
151
     PACKAGE BODY GENERIC1 IS
152
     BEGIN
153
          GI1 := GI1 + 1;
154
          GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
155
          GR1 := (D => 1, FIELD1 => GR1.FIELD1+1);
156
          GP1 := NEW INTEGER'(GP1.ALL + 1);
157
          GV1 := PACK1.NEXT(GV1);
158
          GT1.NEXT;
159
          GK1 := GK1 + 1;
160
     END GENERIC1;
161
 
162
     TASK BODY TASK1 IS
163
          TASK_VALUE : INTEGER := 0;
164
          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
165
     BEGIN
166
          WHILE ACCEPTING_ENTRIES LOOP
167
               SELECT
168
                    ACCEPT ASSIGN (J : IN INTEGER) DO
169
                         TASK_VALUE := J;
170
                    END ASSIGN;
171
               OR
172
                    ACCEPT VALU (J : OUT INTEGER) DO
173
                         J := TASK_VALUE;
174
                    END VALU;
175
               OR
176
                    ACCEPT NEXT DO
177
                         TASK_VALUE := TASK_VALUE + 1;
178
                    END NEXT;
179
               OR
180
                    ACCEPT STOP DO
181
                         ACCEPTING_ENTRIES := FALSE;
182
                    END STOP;
183
               END SELECT;
184
          END LOOP;
185
     END TASK1;
186
 
187
     TASK BODY TASK2 IS
188
     BEGIN
189
          ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
190
                         TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
191
                         TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
192
                         TK1 : IN OUT INTEGER) DO
193
 
194
               TI1 := I1 + 1;
195
               TA1 := (A1(1)+1, A1(2)+1, A1(3)+1);
196
               TR1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
197
               TP1 := NEW INTEGER'(TP1.ALL + 1);
198
               TV1 := PACK1.NEXT(TV1);
199
               TT1.NEXT;
200
               TK1 := TK1 + 1;
201
          END ENTRY1;
202
     END TASK2;
203
 
204
BEGIN
205
     TEST ("C85005A", "CHECK THAT A VARIABLE CREATED BY AN OBJECT " &
206
                      "DECLARATION CAN BE RENAMED AND HAS THE " &
207
                      "CORRECT VALUE, AND THAT THE NEW NAME CAN " &
208
                      "BE USED IN AN ASSIGNMENT STATEMENT " &
209
                      "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
210
                      "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
211
                      "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
212
                      "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
213
                      "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
214
                      "VALUE OF THE NEW NAME");
215
 
216
     DECLARE
217
          PACKAGE GENPACK1 IS NEW
218
               GENERIC1 (XI1, XA1, XR1, XP1, XV1, XT1, XK1);
219
     BEGIN
220
          NULL;
221
     END;
222
 
223
     IF XI1 /= IDENT_INT(1) THEN
224
          FAILED ("INCORRECT VALUE OF XI1 (1)");
225
     END IF;
226
 
227
     IF XA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
228
          FAILED ("INCORRECT VALUE OF XA1 (1)");
229
     END IF;
230
 
231
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
232
          FAILED ("INCORRECT VALUE OF XR1 (1)");
233
     END IF;
234
 
235
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(1) THEN
236
          FAILED ("INCORRECT VALUE OF XP1 (1)");
237
     END IF;
238
 
239
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.ONE)) THEN
240
          FAILED ("INCORRECT VALUE OF XV1 (1)");
241
     END IF;
242
 
243
     XT1.VALU(I);
244
     IF I /= IDENT_INT(1) THEN
245
          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (1)");
246
     END IF;
247
 
248
     IF XK1 /= IDENT_INT(1) THEN
249
          FAILED ("INCORRECT VALUE OF XK1 (1)");
250
     END IF;
251
 
252
     PROC1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
253
 
254
     IF XI1 /= IDENT_INT(2) THEN
255
          FAILED ("INCORRECT VALUE OF XI1 (2)");
256
     END IF;
257
 
258
     IF XA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
259
          FAILED ("INCORRECT VALUE OF XA1 (2)");
260
     END IF;
261
 
262
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
263
          FAILED ("INCORRECT VALUE OF XR1 (2)");
264
     END IF;
265
 
266
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(2) THEN
267
          FAILED ("INCORRECT VALUE OF XP1 (2)");
268
     END IF;
269
 
270
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.TWO)) THEN
271
          FAILED ("INCORRECT VALUE OF XV1 (2)");
272
     END IF;
273
 
274
     XT1.VALU(I);
275
     IF I /= IDENT_INT(2) THEN
276
          FAILED ("INCORRECT RETURN VALUE FROM XT1.VALU (2)");
277
     END IF;
278
 
279
     IF XK1 /= IDENT_INT(2) THEN
280
          FAILED ("INCORRECT VALUE OF XK1 (2)");
281
     END IF;
282
 
283
     CHK_TASK.ENTRY1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
284
 
285
     IF XI1 /= IDENT_INT(3) THEN
286
          FAILED ("INCORRECT VALUE OF XI1 (3)");
287
     END IF;
288
 
289
     IF XA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
290
          FAILED ("INCORRECT VALUE OF XA1 (3)");
291
     END IF;
292
 
293
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
294
          FAILED ("INCORRECT VALUE OF XR1 (3)");
295
     END IF;
296
 
297
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(3) THEN
298
          FAILED ("INCORRECT VALUE OF XP1 (3)");
299
     END IF;
300
 
301
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.THREE)) THEN
302
          FAILED ("INCORRECT VALUE OF XV1 (3)");
303
     END IF;
304
 
305
     XT1.VALU(I);
306
     IF I /= IDENT_INT(3) THEN
307
          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (3)");
308
     END IF;
309
 
310
     IF XK1 /= IDENT_INT(3) THEN
311
          FAILED ("INCORRECT VALUE OF XK1 (3)");
312
     END IF;
313
 
314
     XI1 := XI1 + 1;
315
     XA1 := (XA1(1)+1, XA1(2)+1, XA1(3)+1);
316
     XR1 := (D => 1, FIELD1 => XR1.FIELD1 + 1);
317
     XP1 := NEW INTEGER'(XP1.ALL + 1);
318
     XV1 := PACK1.NEXT(XV1);
319
     XT1.NEXT;
320
     XK1 := XK1 + 1;
321
 
322
     IF XI1 /= IDENT_INT(4) THEN
323
          FAILED ("INCORRECT VALUE OF XI1 (4)");
324
     END IF;
325
 
326
     IF XA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
327
          FAILED ("INCORRECT VALUE OF XA1 (4)");
328
     END IF;
329
 
330
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
331
          FAILED ("INCORRECT VALUE OF XR1 (4)");
332
     END IF;
333
 
334
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(4) THEN
335
          FAILED ("INCORRECT VALUE OF XP1 (4)");
336
     END IF;
337
 
338
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FOUR)) THEN
339
          FAILED ("INCORRECT VALUE OF XV1 (4)");
340
     END IF;
341
 
342
     XT1.VALU(I);
343
     IF I /= IDENT_INT(4) THEN
344
          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (4)");
345
     END IF;
346
 
347
     IF XK1 /= IDENT_INT(4) THEN
348
          FAILED ("INCORRECT VALUE OF XK1 (4)");
349
     END IF;
350
 
351
     I1 := I1 + 1;
352
     A1 := (A1(1)+1, A1(2)+1, A1(3)+1);
353
     R1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
354
     P1 := NEW INTEGER'(P1.ALL + 1);
355
     V1 := PACK1.NEXT(V1);
356
     T1.NEXT;
357
     PACK1.K1 := PACK1.K1 + 1;
358
 
359
     IF XI1 /= IDENT_INT(5) THEN
360
          FAILED ("INCORRECT VALUE OF XI1 (5)");
361
     END IF;
362
 
363
     IF XA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
364
          FAILED ("INCORRECT VALUE OF XA1 (5)");
365
     END IF;
366
 
367
     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
368
          FAILED ("INCORRECT VALUE OF XR1 (5)");
369
     END IF;
370
 
371
     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(5) THEN
372
          FAILED ("INCORRECT VALUE OF XP1 (5)");
373
     END IF;
374
 
375
     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FIVE)) THEN
376
          FAILED ("INCORRECT VALUE OF XV1 (5)");
377
     END IF;
378
 
379
     XT1.VALU(I);
380
     IF I /= IDENT_INT(5) THEN
381
          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (5)");
382
     END IF;
383
 
384
     IF XK1 /= IDENT_INT(5) THEN
385
          FAILED ("INCORRECT VALUE OF XK1 (5)");
386
     END IF;
387
 
388
     T1.STOP;
389
 
390
     RESULT;
391
END C85005A;

powered by: WebSVN 2.1.0

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