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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C34005M.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 THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
27
--     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
28
--     COMPONENT TYPE IS A NON-LIMITED TYPE.
29
 
30
-- HISTORY:
31
--     JRK 9/17/86  CREATED ORIGINAL TEST.
32
--     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
33
 
34
WITH SYSTEM; USE SYSTEM;
35
WITH REPORT; USE REPORT;
36
 
37
PROCEDURE C34005M IS
38
 
39
     SUBTYPE COMPONENT IS INTEGER;
40
 
41
     PACKAGE PKG IS
42
 
43
          FIRST : CONSTANT := 0;
44
          LAST  : CONSTANT := 10;
45
 
46
          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
47
 
48
          TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
49
                               COMPONENT;
50
 
51
          FUNCTION CREATE ( F1, L1 : INDEX;
52
                            F2, L2 : INDEX;
53
                            C      : COMPONENT;
54
                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
55
                          ) RETURN PARENT;
56
 
57
     END PKG;
58
 
59
     USE PKG;
60
 
61
     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
62
                           IDENT_INT (6) .. IDENT_INT (8));
63
 
64
     TYPE ARRT IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
65
                        COMPONENT;
66
 
67
     SUBTYPE ARR IS ARRT (8 .. 9, 2 .. 4);
68
 
69
     X : T                       := (OTHERS => (OTHERS => 2));
70
     W : PARENT (4 .. 5, 6 .. 8) := (OTHERS => (OTHERS => 2));
71
     C : COMPONENT               := 1;
72
     B : BOOLEAN                 := FALSE;
73
     U : ARR                     := (OTHERS => (OTHERS => C));
74
     N : CONSTANT                := 2;
75
 
76
     PROCEDURE A (X : ADDRESS) IS
77
     BEGIN
78
          B := IDENT_BOOL (TRUE);
79
     END A;
80
 
81
     FUNCTION V RETURN T IS
82
     BEGIN
83
          RETURN (OTHERS => (OTHERS => C));
84
     END V;
85
 
86
     PACKAGE BODY PKG IS
87
 
88
          FUNCTION CREATE
89
             ( F1, L1 : INDEX;
90
               F2, L2 : INDEX;
91
               C      : COMPONENT;
92
               DUMMY  : PARENT
93
             ) RETURN PARENT
94
          IS
95
               A : PARENT (F1 .. L1, F2 .. L2);
96
               B : COMPONENT := C;
97
          BEGIN
98
               FOR I IN F1 .. L1 LOOP
99
                    FOR J IN F2 .. L2 LOOP
100
                         A (I, J) := B;
101
                         B := B + 1;
102
                    END LOOP;
103
               END LOOP;
104
               RETURN A;
105
          END CREATE;
106
 
107
     END PKG;
108
 
109
     FUNCTION IDENT (X : T) RETURN T IS
110
     BEGIN
111
          IF EQUAL (X'LENGTH, X'LENGTH) THEN
112
               RETURN X;                          -- ALWAYS EXECUTED.
113
          END IF;
114
          RETURN (OTHERS => (OTHERS => -1));
115
     END IDENT;
116
 
117
BEGIN
118
     TEST ("C34005M", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
119
                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
120
                      "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
121
                      "TYPE IS A NON-LIMITED TYPE");
122
 
123
     X := IDENT (((1, 2, 3), (4, 5, 6)));
124
     IF X /= ((1, 2, 3), (4, 5, 6)) THEN
125
          FAILED ("INCORRECT :=");
126
     END IF;
127
 
128
     IF T'(X) /= ((1, 2, 3), (4, 5, 6)) THEN
129
          FAILED ("INCORRECT QUALIFICATION");
130
     END IF;
131
 
132
     IF T (X) /= ((1, 2, 3), (4, 5, 6)) THEN
133
          FAILED ("INCORRECT SELF CONVERSION");
134
     END IF;
135
 
136
     IF EQUAL (3, 3) THEN
137
          W := ((1, 2, 3), (4, 5, 6));
138
     END IF;
139
     IF T (W) /= ((1, 2, 3), (4, 5, 6)) THEN
140
          FAILED ("INCORRECT CONVERSION FROM PARENT");
141
     END IF;
142
 
143
     BEGIN
144
          IF PARENT (X) /= ((1, 2, 3), (4, 5, 6)) OR
145
             PARENT (CREATE (6, 9, 2, 3, 4, X)) /=
146
             ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
147
               FAILED ("INCORRECT CONVERSION TO PARENT");
148
          END IF;
149
     EXCEPTION
150
          WHEN CONSTRAINT_ERROR =>
151
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
152
          WHEN OTHERS =>
153
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
154
     END;
155
 
156
     IF EQUAL (3, 3) THEN
157
          U := ((1, 2, 3), (4, 5, 6));
158
     END IF;
159
     IF T (U) /= ((1, 2, 3), (4, 5, 6)) THEN
160
          FAILED ("INCORRECT CONVERSION FROM ARRAY");
161
     END IF;
162
 
163
     BEGIN
164
          IF ARR (X) /= ((1, 2, 3), (4, 5, 6)) OR
165
             ARRT (CREATE (7, 9, 2, 5, 3, X)) /=
166
             ((3, 4, 5, 6), (7, 8, 9, 10), (11, 12, 13, 14)) THEN
167
               FAILED ("INCORRECT CONVERSION TO ARRAY");
168
          END IF;
169
     EXCEPTION
170
          WHEN CONSTRAINT_ERROR =>
171
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
172
          WHEN OTHERS =>
173
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
174
     END;
175
 
176
     IF IDENT (((1, 2, 3), (4, 5, 6))) /= ((1, 2, 3), (4, 5, 6)) OR
177
        X = ((1, 2), (3, 4), (5, 6)) THEN
178
          FAILED ("INCORRECT AGGREGATE");
179
     END IF;
180
 
181
     BEGIN
182
          IF X (IDENT_INT (4), IDENT_INT (6)) /= 1 OR
183
             CREATE (6, 9, 2, 3, 4, X) (9, 3) /= 11 THEN
184
               FAILED ("INCORRECT INDEX (VALUE)");
185
          END IF;
186
     EXCEPTION
187
          WHEN CONSTRAINT_ERROR =>
188
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
189
          WHEN OTHERS =>
190
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
191
     END;
192
 
193
     X (IDENT_INT (5), IDENT_INT (8)) := 7;
194
     IF X /= ((1, 2, 3), (4, 5, 7)) THEN
195
          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
196
     END IF;
197
 
198
     X := IDENT (((1, 2, 3), (4, 5, 6)));
199
     IF X = IDENT (((1, 2, 3), (4, 5, 7))) OR
200
        X = ((1, 2), (4, 5)) THEN
201
          FAILED ("INCORRECT =");
202
     END IF;
203
 
204
     IF X /= IDENT (((1, 2, 3), (4, 5, 6))) OR
205
        NOT (X /= ((1, 2, 3), (4, 5, 6), (7, 8, 9))) THEN
206
          FAILED ("INCORRECT /=");
207
     END IF;
208
 
209
     IF NOT (X IN T) OR ((1, 2), (3, 4)) IN T THEN
210
          FAILED ("INCORRECT ""IN""");
211
     END IF;
212
 
213
     IF X NOT IN T OR
214
        NOT (((1, 2, 3), (4, 5, 6), (7, 8, 9)) NOT IN T) THEN
215
          FAILED ("INCORRECT ""NOT IN""");
216
     END IF;
217
 
218
     B := FALSE;
219
     A (X'ADDRESS);
220
     IF NOT B THEN
221
          FAILED ("INCORRECT 'ADDRESS");
222
     END IF;
223
 
224
     IF T'FIRST /= 4 THEN
225
          FAILED ("INCORRECT TYPE'FIRST");
226
     END IF;
227
 
228
     IF X'FIRST /= 4 THEN
229
          FAILED ("INCORRECT OBJECT'FIRST");
230
     END IF;
231
 
232
     IF V'FIRST /= 4 THEN
233
          FAILED ("INCORRECT VALUE'FIRST");
234
     END IF;
235
 
236
     IF T'FIRST (N) /= 6 THEN
237
          FAILED ("INCORRECT TYPE'FIRST (N)");
238
     END IF;
239
 
240
     IF X'FIRST (N) /= 6 THEN
241
          FAILED ("INCORRECT OBJECT'FIRST (N)");
242
     END IF;
243
 
244
     IF V'FIRST (N) /= 6 THEN
245
          FAILED ("INCORRECT VALUE'FIRST (N)");
246
     END IF;
247
 
248
     IF T'LAST /= 5 THEN
249
          FAILED ("INCORRECT TYPE'LAST");
250
     END IF;
251
 
252
     IF X'LAST /= 5 THEN
253
          FAILED ("INCORRECT OBJECT'LAST");
254
     END IF;
255
 
256
     IF V'LAST /= 5 THEN
257
          FAILED ("INCORRECT VALUE'LAST");
258
     END IF;
259
 
260
     IF T'LAST (N) /= 8 THEN
261
          FAILED ("INCORRECT TYPE'LAST (N)");
262
     END IF;
263
 
264
     IF X'LAST (N) /= 8 THEN
265
          FAILED ("INCORRECT OBJECT'LAST (N)");
266
     END IF;
267
 
268
     IF V'LAST (N) /= 8 THEN
269
          FAILED ("INCORRECT VALUE'LAST (N)");
270
     END IF;
271
 
272
     IF T'LENGTH /= 2 THEN
273
          FAILED ("INCORRECT TYPE'LENGTH");
274
     END IF;
275
 
276
     IF X'LENGTH /= 2 THEN
277
          FAILED ("INCORRECT OBJECT'LENGTH");
278
     END IF;
279
 
280
     IF V'LENGTH /= 2 THEN
281
          FAILED ("INCORRECT VALUE'LENGTH");
282
     END IF;
283
 
284
     IF T'LENGTH (N) /= 3 THEN
285
          FAILED ("INCORRECT TYPE'LENGTH (N)");
286
     END IF;
287
 
288
     IF X'LENGTH (N) /= 3 THEN
289
          FAILED ("INCORRECT OBJECT'LENGTH (N)");
290
     END IF;
291
 
292
     IF V'LENGTH (N) /= 3 THEN
293
          FAILED ("INCORRECT VALUE'LENGTH (N)");
294
     END IF;
295
 
296
     DECLARE
297
          Y : PARENT (T'RANGE, 1 .. 3);
298
     BEGIN
299
          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
300
               FAILED ("INCORRECT TYPE'RANGE");
301
          END IF;
302
     END;
303
 
304
     DECLARE
305
          Y : PARENT (X'RANGE, 1 .. 3);
306
     BEGIN
307
          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
308
               FAILED ("INCORRECT OBJECT'RANGE");
309
          END IF;
310
     END;
311
 
312
     DECLARE
313
          Y : PARENT (V'RANGE, 1 .. 3);
314
     BEGIN
315
          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
316
               FAILED ("INCORRECT VALUE'RANGE");
317
          END IF;
318
     END;
319
 
320
     DECLARE
321
          Y : PARENT (1 .. 2, T'RANGE (N));
322
     BEGIN
323
          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
324
               FAILED ("INCORRECT TYPE'RANGE (N)");
325
          END IF;
326
     END;
327
 
328
     DECLARE
329
          Y : PARENT (1 .. 2, X'RANGE (N));
330
     BEGIN
331
          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
332
               FAILED ("INCORRECT OBJECT'RANGE (N)");
333
          END IF;
334
     END;
335
 
336
     DECLARE
337
          Y : PARENT (1 .. 2, V'RANGE (N));
338
     BEGIN
339
          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
340
               FAILED ("INCORRECT VALUE'RANGE (N)");
341
          END IF;
342
     END;
343
 
344
     IF T'SIZE < T'LENGTH * T'LENGTH (N) * COMPONENT'SIZE THEN
345
          FAILED ("INCORRECT TYPE'SIZE");
346
     END IF;
347
 
348
     IF X'SIZE < X'LENGTH * X'LENGTH (N) * COMPONENT'SIZE THEN
349
          FAILED ("INCORRECT OBJECT'SIZE");
350
     END IF;
351
 
352
     RESULT;
353
END C34005M;

powered by: WebSVN 2.1.0

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