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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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