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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC1225A.TST
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, FOR A FORMAL ACCESS TYPE, THAT ALL ALLOWABLE OPERATIONS
27
--     ARE IMPLICITLY DECLARED.
28
 
29
-- MACRO SUBSTITUTION:
30
--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
31
--     THE ACTIVATION OF A TASK.
32
 
33
-- HISTORY:
34
--     BCB 03/29/88  CREATED ORIGINAL TEST.
35
--     RDH 04/09/90  ADDED 'STORAGE_SIZE CLAUSES.  CHANGED EXTENSION TO
36
--                   'TST'.
37
--     LDC 09/26/90  REMOVED 'USE PACK' AFTER THE WITH SINCE IT ISN'T
38
--                   NEEDED, ADDED CHECK FOR NULL AFTER ASSIGMENT TO
39
--                   NULL, ADDED CHECKS FOR OTHER RELATION OPERATORS,
40
--                   CHANGED CHECK FOR 'ADDRESS TO A PROCEDURE CALL.
41
--     LDC 10/13/90  CHANGED CHECK FOR 'SIZE TO ONLY CHECK FOR
42
--                   AVAILABILITY.  CHANGED CHECK FOR 'ADDRESS TO A
43
--                   MEMBERSHIP TEST.
44
--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
45
 
46
WITH REPORT; USE REPORT;
47
WITH SYSTEM; USE SYSTEM;
48
 
49
PROCEDURE CC1225A IS
50
 
51
     TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
52
 
53
     TYPE AI IS ACCESS INTEGER;
54
 
55
     TYPE ACCINTEGER IS ACCESS INTEGER;
56
 
57
     TYPE REC IS RECORD
58
          COMP : INTEGER;
59
     END RECORD;
60
 
61
     TYPE DISCREC (DISC : INTEGER := 1) IS RECORD
62
          COMPD : INTEGER;
63
     END RECORD;
64
 
65
     TYPE AREC IS ACCESS REC;
66
 
67
     TYPE ADISCREC IS ACCESS DISCREC;
68
 
69
     TYPE ARR IS ARRAY(1..2,1..2) OF INTEGER;
70
 
71
     TYPE ONEDIM IS ARRAY(1..10) OF INTEGER;
72
 
73
     TYPE AA IS ACCESS ARR;
74
 
75
     TYPE AONEDIM IS ACCESS ONEDIM;
76
 
77
     TYPE ENUM IS (ONE, TWO, THREE);
78
 
79
     TASK TYPE T IS
80
          ENTRY HERE(VAL : IN OUT INTEGER);
81
     END T;
82
 
83
     TYPE ATASK IS ACCESS T;
84
 
85
     TYPE ANOTHERTASK IS ACCESS T;
86
     FOR ANOTHERTASK'STORAGE_SIZE USE 2 * TASK_STORAGE_SIZE;
87
 
88
     TASK TYPE T1 IS
89
          ENTRY HERE1(ENUM)(VAL1 : IN OUT INTEGER);
90
     END T1;
91
 
92
     TYPE ATASK1 IS ACCESS T1;
93
 
94
     TASK BODY T IS
95
     BEGIN
96
          ACCEPT HERE(VAL : IN OUT INTEGER) DO
97
               VAL := VAL * 2;
98
          END HERE;
99
     END T;
100
 
101
     TASK BODY T1 IS
102
     BEGIN
103
          SELECT
104
               ACCEPT HERE1(ONE)(VAL1 : IN OUT INTEGER) DO
105
                    VAL1 := VAL1 * 1;
106
               END HERE1;
107
          OR
108
               ACCEPT HERE1(TWO)(VAL1 : IN OUT INTEGER) DO
109
                    VAL1 := VAL1 * 2;
110
               END HERE1;
111
          OR
112
               ACCEPT HERE1(THREE)(VAL1 : IN OUT INTEGER) DO
113
                    VAL1 := VAL1 * 3;
114
               END HERE1;
115
          END SELECT;
116
     END T1;
117
 
118
     GENERIC
119
          TYPE FORM IS (<>);
120
          TYPE ACCFORM IS ACCESS FORM;
121
          TYPE ACC IS ACCESS INTEGER;
122
          TYPE ACCREC IS ACCESS REC;
123
          TYPE ACCDISCREC IS ACCESS DISCREC;
124
          TYPE ACCARR IS ACCESS ARR;
125
          TYPE ACCONE IS ACCESS ONEDIM;
126
          TYPE ACCTASK IS ACCESS T;
127
          TYPE ACCTASK1 IS ACCESS T1;
128
          TYPE ANOTHERTASK1 IS ACCESS T;
129
     PACKAGE P IS
130
     END P;
131
 
132
     PACKAGE BODY P IS
133
          AF : ACCFORM;
134
          TYPE DER_ACC IS NEW ACC;
135
          A, B : ACC;
136
          DERA : DER_ACC;
137
          R : ACCREC;
138
          DR : ACCDISCREC;
139
          C : ACCARR;
140
          D, E : ACCONE;
141
          F : ACCTASK;
142
          G : ACCTASK1;
143
          INT : INTEGER := 5;
144
 
145
     BEGIN
146
          TEST ("CC1225A", "CHECK, FOR A FORMAL ACCESS TYPE, THAT " &
147
                           "ALL ALLOWABLE OPERATIONS ARE IMPLICITLY " &
148
                           "DECLARED");
149
 
150
          IF AF'ADDRESS NOT IN ADDRESS THEN
151
               FAILED ("IMPROPER RESULT FROM AF'ADDRESS TEST");
152
          END IF;
153
 
154
          DECLARE
155
               AF_SIZE : INTEGER := ACCFORM'SIZE;
156
          BEGIN
157
               IF AF_SIZE NOT IN INTEGER THEN
158
                    FAILED ("IMPROPER RESULT FROM AF'SIZE");
159
               END IF;
160
          END;
161
 
162
          IF ANOTHERTASK1'STORAGE_SIZE < TASK_STORAGE_SIZE THEN
163
               FAILED ("IMPROPER VALUE FOR ANOTHERTASK1'STORAGE_SIZE");
164
          END IF;
165
 
166
          B := NEW INTEGER'(25);
167
 
168
          A := B;
169
 
170
          IF A.ALL /= 25 THEN
171
               FAILED ("IMPROPER VALUE FOR ASSIGNMENT OF VARIABLE " &
172
                       "OF A FORMAL ACCESS TYPE FROM ANOTHER " &
173
                       "VARIABLE OF A FORMAL ACCESS TYPE");
174
          END IF;
175
 
176
          A := NEW INTEGER'(10);
177
 
178
          IF A.ALL /= 10 THEN
179
               FAILED ("IMPROPER VALUE FOR VARIABLE OF FORMAL ACCESS " &
180
                       "TYPE");
181
          END IF;
182
 
183
          IF A NOT IN ACC THEN
184
               FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
185
          END IF;
186
 
187
          B := ACC'(A);
188
 
189
          IF B.ALL /= 10 THEN
190
               FAILED ("IMPROPER VALUE FROM QUALIFICATION");
191
          END IF;
192
 
193
          DERA := NEW INTEGER'(10);
194
          A := ACC(DERA);
195
 
196
          IF A.ALL /= IDENT_INT(10) THEN
197
               FAILED ("IMPROPER VALUE FROM EXPLICIT CONVERSION");
198
          END IF;
199
 
200
          IF A.ALL > IDENT_INT(10) THEN
201
               FAILED ("IMPROPER VALUE USED IN LESS THAN");
202
          END IF;
203
 
204
          IF A.ALL < IDENT_INT(10) THEN
205
               FAILED ("IMPROPER VALUE USED IN GREATER THAN");
206
          END IF;
207
 
208
          IF A.ALL >= IDENT_INT(11) THEN
209
               FAILED ("IMPROPER VALUE USED IN LESS THAN OR EQUAL");
210
          END IF;
211
 
212
          IF A.ALL <= IDENT_INT(9) THEN
213
               FAILED ("IMPROPER VALUE USED IN GREATER THAN OR EQUAL");
214
          END IF;
215
 
216
          IF NOT (A.ALL + A.ALL = IDENT_INT(20)) THEN
217
               FAILED ("IMPROPER VALUE FROM ADDITION");
218
          END IF;
219
 
220
          IF NOT (A.ALL - IDENT_INT(2) = IDENT_INT(8)) THEN
221
               FAILED ("IMPROPER VALUE FROM SUBTRACTION");
222
          END IF;
223
 
224
          IF NOT (A.ALL * IDENT_INT(3) = IDENT_INT(30)) THEN
225
               FAILED ("IMPROPER VALUE FROM MULTIPLICATION");
226
          END IF;
227
 
228
          IF NOT (A.ALL / IDENT_INT(3) = IDENT_INT(3)) THEN
229
               FAILED ("IMPROPER VALUE FROM DIVISION");
230
          END IF;
231
 
232
          IF NOT (A.ALL MOD IDENT_INT(3) = IDENT_INT(1)) THEN
233
               FAILED ("IMPROPER VALUE FROM MODULO");
234
          END IF;
235
 
236
          IF NOT (A.ALL REM IDENT_INT(7) = IDENT_INT(3)) THEN
237
               FAILED ("IMPROPER VALUE FROM REMAINDER");
238
          END IF;
239
 
240
          IF NOT (A.ALL ** IDENT_INT(2) = IDENT_INT(100)) THEN
241
               FAILED ("IMPROPER VALUE FROM EXPONENTIATION");
242
          END IF;
243
 
244
          IF NOT (+A.ALL = IDENT_INT(10)) THEN
245
               FAILED ("IMPROPER VALUE FROM IDENTITY");
246
          END IF;
247
 
248
          IF NOT (-A.ALL = IDENT_INT(-10)) THEN
249
               FAILED ("IMPROPER VALUE FROM NEGATION");
250
          END IF;
251
 
252
          A := NULL;
253
 
254
          IF A /= NULL THEN
255
               FAILED ("IMPROPER VALUE FROM ACCESS SET TO NULL");
256
          END IF;
257
 
258
          IF A'ADDRESS NOT IN ADDRESS THEN
259
               FAILED ("IMPROPER RESULT FROM A'ADDRESS TEST");
260
          END IF;
261
 
262
 
263
          DECLARE
264
               ACC_SIZE : INTEGER := ACC'SIZE;
265
          BEGIN
266
               IF ACC_SIZE NOT IN INTEGER THEN
267
                    FAILED ("IMPROPER RESULT FROM ACC'SIZE");
268
               END IF;
269
          END;
270
 
271
          R := NEW REC'(COMP => 5);
272
 
273
          IF NOT EQUAL(R.COMP,5) THEN
274
               FAILED ("IMPROPER VALUE FOR RECORD COMPONENT");
275
          END IF;
276
 
277
          DR := NEW DISCREC'(DISC => 1, COMPD => 5);
278
 
279
          IF NOT EQUAL(DR.DISC,1) OR NOT EQUAL(DR.COMPD,5) THEN
280
               FAILED ("IMPROPER VALUES FOR DISCRIMINATED RECORD " &
281
                       "COMPONENTS");
282
          END IF;
283
 
284
          C := NEW ARR'(1 => (1,2), 2 => (3,4));
285
 
286
          IF C(1,1) /= 1 OR C(1,2) /= 2 OR C(2,1) /= 3 OR C(2,2) /= 4
287
               THEN FAILED ("IMPROPER ARRAY COMPONENT VALUES");
288
          END IF;
289
 
290
          D := NEW ONEDIM'(1,2,3,4,5,6,7,8,9,10);
291
          E := NEW ONEDIM'(10,9,8,7,6,5,4,3,2,1);
292
 
293
          D(1..5) := E(1..5);
294
 
295
          IF D(1) /= 10 OR D(2) /= 9 OR D(3) /= 8
296
               OR D(4) /= 7 OR D(5) /= 6 THEN
297
               FAILED ("IMPROPER RESULTS FROM SLICE ASSIGNMENT");
298
          END IF;
299
 
300
          IF C'FIRST /= 1 OR C'FIRST(2) /= 1 THEN
301
               FAILED ("IMPROPER LOWER BOUNDS FOR CONSTRAINED ARRAY");
302
          END IF;
303
 
304
          IF C'LAST /= 2 OR C'LAST(2) /= 2 THEN
305
               FAILED ("IMPROPER UPPER BOUNDS FOR CONSTRAINED ARRAY");
306
          END IF;
307
 
308
          IF 1 NOT IN C'RANGE THEN
309
               FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 1");
310
          END IF;
311
 
312
          IF 1 NOT IN C'RANGE(2) THEN
313
               FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 2");
314
          END IF;
315
 
316
          IF C'LENGTH /= 2 THEN
317
               FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &
318
                       "ARRAY - 1");
319
          END IF;
320
 
321
          IF C'LENGTH(2) /= 2 THEN
322
               FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &
323
                       "ARRAY - 2");
324
          END IF;
325
 
326
          F := NEW T;
327
 
328
          F.HERE(INT);
329
 
330
          IF NOT EQUAL(INT,IDENT_INT(10)) THEN
331
               FAILED ("IMPROPER RESULTS FROM ENTRY SELECTION");
332
          END IF;
333
 
334
          G := NEW T1;
335
 
336
          G.HERE1(TWO)(INT);
337
 
338
          IF NOT EQUAL(INT,IDENT_INT(20)) THEN
339
               FAILED ("IMPROPER RESULTS FROM FAMILY ENTRY SELECTION");
340
          END IF;
341
 
342
          RESULT;
343
     END P;
344
 
345
     PACKAGE PACK IS NEW P(INTEGER,ACCINTEGER,AI,AREC,ADISCREC,
346
                           AA,AONEDIM,ATASK,ATASK1,ANOTHERTASK);
347
 
348
BEGIN
349
     NULL;
350
END CC1225A;

powered by: WebSVN 2.1.0

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