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/] [c3/] [c32107a.ada] - Blame information for rev 309

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

Line No. Rev Author Line
1 294 jeremybenn
-- C32107A.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
-- CHECK THAT OBJECT DECLARATIONS ARE ELABORATED IN THE ORDER OF THEIR 
26
-- OCCURRENCE, I.E., THAT EXPRESSIONS ASSOCIATED WITH ONE DECLARATION
27
-- (INCLUDING DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE EVALUATED BEFORE
28
-- ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. ALSO, CHECK THAT
29
-- EXPRESSIONS IN THE SUBTYPE INDICATION OR THE CONSTRAINED ARRAY 
30
-- DEFINITION ARE EVALUATED BEFORE ANY INITIALIZATION EXPRESSIONS ARE
31
-- EVALUATED.
32
 
33
-- R.WILLIAMS 9/24/86
34
 
35
WITH REPORT; USE REPORT;
36
PROCEDURE C32107A IS
37
 
38
     BUMP : INTEGER := 0;
39
 
40
     ORDER_CHECK : INTEGER;
41
 
42
     G1, H1, I1 : INTEGER;
43
 
44
     FIRST_CALL : BOOLEAN := TRUE;
45
 
46
     TYPE ARR1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
47
 
48
     TYPE ARR1_NAME IS ACCESS ARR1;
49
 
50
     TYPE ARR2 IS ARRAY (POSITIVE RANGE <>, POSITIVE RANGE <>) OF
51
          INTEGER;
52
 
53
     TYPE REC (D : INTEGER) IS
54
          RECORD
55
               COMP : INTEGER;
56
          END RECORD;
57
 
58
     TYPE REC_NAME IS ACCESS REC;
59
 
60
     FUNCTION F RETURN INTEGER IS
61
     BEGIN
62
          BUMP := BUMP + 1;
63
          RETURN BUMP;
64
     END F;
65
 
66
     FUNCTION G RETURN INTEGER IS
67
     BEGIN
68
          BUMP := BUMP + 1;
69
          G1 := BUMP;
70
          RETURN BUMP;
71
     END G;
72
 
73
     FUNCTION H RETURN INTEGER IS
74
     BEGIN
75
          BUMP := BUMP + 1;
76
          H1 := BUMP;
77
          RETURN BUMP;
78
     END H;
79
 
80
     FUNCTION I RETURN INTEGER IS
81
     BEGIN
82
          IF FIRST_CALL THEN
83
               BUMP := BUMP + 1;
84
               I1 := BUMP;
85
               FIRST_CALL := FALSE;
86
          END IF;
87
          RETURN I1;
88
     END I;
89
 
90
BEGIN
91
     TEST ( "C32107A", "CHECK THAT OBJECT DECLARATIONS ARE " &
92
                       "ELABORATED IN THE ORDER OF THEIR " &
93
                       "OCCURRENCE, I.E., THAT EXPRESSIONS " &
94
                       "ASSOCIATED WITH ONE DECLARATION (INCLUDING " &
95
                       "DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE " &
96
                       "EVALUATED BEFORE ANY EXPRESSION BELONGING " &
97
                       "TO THE NEXT DECLARATION.  ALSO, CHECK THAT " &
98
                       "EXPRESSIONS IN THE SUBTYPE INDICATION OR " &
99
                       "THE CONSTRAINED ARRAY DEFINITION ARE " &
100
                       "EVALUATED BEFORE ANY INITIALIZATION " &
101
                       "EXPRESSIONS ARE EVALUATED" );
102
 
103
     DECLARE -- (A).
104
          I1 : INTEGER := 10000 * F;
105
          A1 : CONSTANT ARRAY (1 .. H) OF REC (G * 100) :=
106
               (1 .. H1 => (G1 * 100, I * 10));
107
          I2 : CONSTANT INTEGER := F * 1000;
108
     BEGIN
109
          ORDER_CHECK := I1 + I2 + A1'LAST + A1 (1).D + A1 (1).COMP;
110
          IF ORDER_CHECK = 15243 OR ORDER_CHECK = 15342 THEN
111
               COMMENT ( "ORDER_CHECK HAS VALUE " &
112
                          INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
113
          ELSE
114
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
115
                        "VALUE OF ORDER_CHECK SHOULD BE 15343 OR " &
116
                        "15242 -- ACTUAL VALUE IS " &
117
                         INTEGER'IMAGE (ORDER_CHECK) & " - (A)" );
118
          END IF;
119
     END; -- (A).         
120
 
121
     BUMP := 0;
122
 
123
     DECLARE -- (B).
124
          A : ARR2 (1 .. F, 1 .. F * 10);
125
          R : REC (G * 100) := (G1 * 100, F * 1000);
126
          I : INTEGER RANGE 1 .. H;
127
          S : REC (F * 10);
128
     BEGIN
129
          ORDER_CHECK :=
130
               A'LAST (1) + A'LAST (2) + R.D + R.COMP;
131
          IF (H1 + S.D = 65) AND
132
             (ORDER_CHECK = 4321 OR ORDER_CHECK = 4312) THEN
133
               COMMENT ( "ORDER_CHECK HAS VALUE 65 " &
134
                          INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
135
          ELSE
136
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
137
                        "VALUE OF ORDER_CHECK SHOULD BE 65 4321 OR " &
138
                        "65 4312 -- ACTUAL VALUE IS " &
139
                         INTEGER'IMAGE (H1 + S.D) &
140
                         INTEGER'IMAGE (ORDER_CHECK) & " - (B)" );
141
          END IF;
142
     END; -- (B).         
143
 
144
     BUMP := 0;
145
 
146
     DECLARE -- (C).
147
          I1 : CONSTANT INTEGER RANGE 1 .. G * 10 := F;
148
          A1 : ARRAY (1 .. F * 100) OF INTEGER RANGE 1 .. H * 1000;
149
     BEGIN
150
          ORDER_CHECK := I1 + (G1 * 10) + A1'LAST + (H1 * 1000);
151
          IF ORDER_CHECK = 4312 OR ORDER_CHECK = 3412 THEN
152
               COMMENT ( "ORDER_CHECK HAS VALUE " &
153
                          INTEGER'IMAGE (ORDER_CHECK) & " - (C)" );
154
          ELSE
155
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
156
                        "VALUE OF ORDER_CHECK SHOULD BE 4312 OR " &
157
                        "3412 -- ACTUAL VALUE IS " &
158
                         INTEGER'IMAGE (ORDER_CHECK) & " - (C)" );
159
          END IF;
160
     END; -- (C).         
161
 
162
     BUMP := 0;
163
     FIRST_CALL := TRUE;
164
 
165
     DECLARE -- (D).
166
          A1 : ARRAY (1 .. G) OF REC (H * 10000) :=
167
               (1 .. G1 => (H1 * 10000, I * 100));
168
          R1 : CONSTANT REC := (F * 1000, F * 10);
169
 
170
     BEGIN
171
          ORDER_CHECK :=
172
               A1'LAST + A1 (1).D + A1 (1).COMP + R1.D + R1.COMP;
173
          IF ORDER_CHECK = 25341 OR ORDER_CHECK = 24351 OR
174
             ORDER_CHECK = 15342 OR ORDER_CHECK = 14352 THEN
175
               COMMENT ( "ORDER_CHECK HAS VALUE " &
176
                          INTEGER'IMAGE (ORDER_CHECK) & " - (D)" );
177
          ELSE
178
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
179
                        "VALUE OF ORDER_CHECK SHOULD BE 25341, " &
180
                        "24351, 15342 OR 14352  -- ACTUAL VALUE IS " &
181
                         INTEGER'IMAGE (ORDER_CHECK) & " - (D)" );
182
          END IF;
183
     END; -- (D).         
184
 
185
     BUMP := 0;
186
 
187
     DECLARE -- (E).
188
          A1 : CONSTANT ARR1_NAME := NEW ARR1' (1 .. F => F * 10);
189
          R1 : REC_NAME (H * 100) := NEW REC'(H1 * 100, F * 1000);
190
 
191
     BEGIN
192
          ORDER_CHECK := A1.ALL'LAST + A1.ALL (1) + R1.D + R1.COMP;
193
          IF ORDER_CHECK /= 4321 THEN
194
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
195
                        "VALUE OF ORDER_CHECK SHOULD BE 4321 " &
196
                        "-- ACTUAL VALUE IS " &
197
                         INTEGER'IMAGE (ORDER_CHECK) & " - (E)" );
198
          END IF;
199
     END; -- (E).         
200
 
201
     BUMP := 0;
202
     FIRST_CALL := TRUE;
203
 
204
     DECLARE -- (F).
205
          A1 : CONSTANT ARRAY (1 .. G) OF INTEGER RANGE 1 .. H * 100 :=
206
               (1 .. G1 => I * 10);
207
          A2 : ARR1 (1 .. F * 1000);
208
     BEGIN
209
          ORDER_CHECK :=
210
               A1'LAST + (H1 * 100) + A1 (1) + A2'LAST;
211
          IF ORDER_CHECK = 4231 OR ORDER_CHECK = 4132 THEN
212
               COMMENT ( "ORDER_CHECK HAS VALUE " &
213
                          INTEGER'IMAGE (ORDER_CHECK) & " - (F)" );
214
          ELSE
215
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
216
                        "VALUE OF ORDER_CHECK SHOULD BE 4231 OR " &
217
                        "4132 -- ACTUAL VALUE IS " &
218
                         INTEGER'IMAGE (ORDER_CHECK) & " - (F)" );
219
          END IF;
220
     END; -- (F).         
221
 
222
     BUMP := 0;
223
 
224
     DECLARE -- (G).
225
          A1 : ARR1_NAME (1 .. G) := NEW ARR1 (1 .. G1);
226
          R1 : CONSTANT REC_NAME (H * 10) :=
227
               NEW REC'(H1 * 10, F * 100);
228
     BEGIN
229
          ORDER_CHECK := A1.ALL'LAST + R1.D + R1.COMP;
230
          IF ORDER_CHECK /= 321 THEN
231
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
232
                        "VALUE OF ORDER_CHECK SHOULD BE 321 OR " &
233
                        "-- ACTUAL VALUE IS " &
234
                         INTEGER'IMAGE (ORDER_CHECK) & " - (G)" );
235
          END IF;
236
     END; -- (G).         
237
 
238
     BUMP := 0;
239
 
240
     DECLARE -- (H). 
241
          TYPE REC (D : INTEGER := F) IS
242
               RECORD
243
                    COMP : INTEGER := F * 10;
244
               END RECORD;
245
 
246
          R1 : REC;
247
          R2 : REC (G * 100) := (G1 * 100, F * 1000);
248
     BEGIN
249
          ORDER_CHECK := R1.D + R1.COMP + R2.D + R2.COMP;
250
          IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
251
             ORDER_CHECK = 3421 OR ORDER_CHECK = 3412 THEN
252
               COMMENT ( "ORDER_CHECK HAS VALUE " &
253
                          INTEGER'IMAGE (ORDER_CHECK) & " - (H)" );
254
          ELSE
255
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
256
                        "VALUE OF ORDER_CHECK SHOULD BE 4321, " &
257
                        "4312, 3421, OR 3412 -- ACTUAL VALUE IS " &
258
                         INTEGER'IMAGE (ORDER_CHECK) & " - (H)" );
259
          END IF;
260
     END; -- (H).         
261
 
262
     BUMP := 0;
263
 
264
     DECLARE -- (I).
265
          TYPE REC2 (D1, D2 : INTEGER) IS
266
               RECORD
267
                    COMP : INTEGER;
268
               END RECORD;
269
 
270
          R1 : REC2 (G  * 1000, H  * 10000) :=
271
                    (G1 * 1000, H1 * 10000, F * 100);
272
          R2 : REC2 (F, F * 10);
273
     BEGIN
274
          ORDER_CHECK := R1.D1 + R1.D2 + R1.COMP + R2.D1 + R2.D2;
275
          IF ORDER_CHECK = 21354 OR ORDER_CHECK = 21345 OR
276
             ORDER_CHECK = 12345 OR ORDER_CHECK = 12354 THEN
277
               COMMENT ( "ORDER_CHECK HAS VALUE " &
278
                          INTEGER'IMAGE (ORDER_CHECK) & " - (I)" );
279
          ELSE
280
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
281
                        "VALUE OF ORDER_CHECK SHOULD BE 21354, " &
282
                        "21345, 12354, OR 12345 -- ACTUAL VALUE IS " &
283
                         INTEGER'IMAGE (ORDER_CHECK) & " - (I)" );
284
          END IF;
285
 
286
     END; -- (I).         
287
 
288
     BUMP := 0;
289
 
290
     DECLARE -- (J).
291
          PACKAGE P IS
292
               TYPE PRIV (D : INTEGER) IS PRIVATE;
293
 
294
               P1 : CONSTANT PRIV;
295
               P2 : CONSTANT PRIV;
296
 
297
               FUNCTION GET_A (P : PRIV) RETURN INTEGER;
298
          PRIVATE
299
               TYPE PRIV (D : INTEGER) IS
300
                    RECORD
301
                         COMP : INTEGER;
302
                    END RECORD;
303
               P1 : CONSTANT PRIV := (F , F * 10);
304
               P2 : CONSTANT PRIV := (F * 100, F * 1000);
305
          END P;
306
 
307
          PACKAGE BODY P IS
308
               FUNCTION GET_A (P : PRIV) RETURN INTEGER IS
309
               BEGIN
310
                    RETURN P.COMP;
311
               END GET_A;
312
          END P;
313
 
314
          USE P;
315
     BEGIN
316
          ORDER_CHECK := P1.D + GET_A (P1) + P2.D + GET_A (P2);
317
          IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
318
             ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN
319
               COMMENT ( "ORDER_CHECK HAS VALUE " &
320
                          INTEGER'IMAGE (ORDER_CHECK) & " - (J)" );
321
          ELSE
322
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
323
                        "VALUE OF ORDER_CHECK SHOULD BE 4321, " &
324
                        "4312, 3421, OR 3412 -- ACTUAL VALUE IS " &
325
                         INTEGER'IMAGE (ORDER_CHECK) & " - (J)" );
326
          END IF;
327
     END; -- (J).         
328
 
329
     BUMP := 0;
330
 
331
     DECLARE -- (K).
332
          PACKAGE P IS
333
               TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE;
334
 
335
          PRIVATE
336
               TYPE PRIV (D1, D2 : INTEGER) IS
337
                    RECORD
338
                         NULL;
339
                    END RECORD;
340
          END P;
341
 
342
          USE P;
343
 
344
          P1 : PRIV (F, F * 10);
345
          P2 : PRIV (F * 100, F * 1000);
346
 
347
     BEGIN
348
          ORDER_CHECK := P1.D1 + P1.D2 + P2.D1 + P2.D2;
349
          IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR
350
             ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN
351
               COMMENT ( "ORDER_CHECK HAS VALUE " &
352
                          INTEGER'IMAGE (ORDER_CHECK) & " - (K)" );
353
          ELSE
354
               FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " &
355
                        "VALUE OF ORDER_CHECK SHOULD BE 4321, 4312, " &
356
                        "3421, OR 3412 -- ACTUAL VALUE IS " &
357
                         INTEGER'IMAGE (ORDER_CHECK) & " - (K)" );
358
          END IF;
359
 
360
     END; -- (K).         
361
 
362
     RESULT;
363
END C32107A;

powered by: WebSVN 2.1.0

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