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/] [c34005g.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
-- C34005G.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 ONE-DIMENSIONAL ARRAY TYPES
28
--    WHOSE COMPONENT TYPE IS A CHARACTER TYPE.
29
 
30
-- HISTORY:
31
--    JRK 9/15/86  CREATED ORIGINAL TEST.
32
--    RJW 8/21/89  MODIFIED CHECKS FOR OBJECT AND TYPE SIZES.
33
--    PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
34
 
35
WITH SYSTEM; USE SYSTEM;
36
WITH REPORT; USE REPORT;
37
 
38
PROCEDURE C34005G IS
39
 
40
     TYPE COMPONENT IS NEW CHARACTER;
41
 
42
     PACKAGE PKG IS
43
 
44
          FIRST : CONSTANT := 0;
45
          LAST  : CONSTANT := 100;
46
 
47
          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
48
 
49
          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
50
 
51
          FUNCTION CREATE ( F, L  : INDEX;
52
                            C     : COMPONENT;
53
                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
54
                          ) RETURN PARENT;
55
 
56
     END PKG;
57
 
58
     USE PKG;
59
 
60
     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
61
 
62
     TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
63
     SUBTYPE ARR IS ARRT (2 .. 4);
64
 
65
     X : T               := (OTHERS => 'B');
66
     W : PARENT (5 .. 7) := (OTHERS => 'B');
67
     C : COMPONENT       := 'A';
68
     B : BOOLEAN         := FALSE;
69
     U : ARR             := (OTHERS => C);
70
     N : CONSTANT        := 1;
71
 
72
     PROCEDURE A (X : ADDRESS) IS
73
     BEGIN
74
          B := IDENT_BOOL (TRUE);
75
     END A;
76
 
77
     FUNCTION V RETURN T IS
78
     BEGIN
79
          RETURN (OTHERS => C);
80
     END V;
81
 
82
     PACKAGE BODY PKG IS
83
 
84
          FUNCTION CREATE
85
             ( F, L  : INDEX;
86
               C     : COMPONENT;
87
               DUMMY : PARENT
88
             ) RETURN PARENT
89
          IS
90
               A : PARENT (F .. L);
91
               B : COMPONENT := C;
92
          BEGIN
93
               FOR I IN F .. L LOOP
94
                    A (I) := B;
95
                    B := COMPONENT'SUCC (B);
96
               END LOOP;
97
               RETURN A;
98
          END CREATE;
99
 
100
     END PKG;
101
 
102
     FUNCTION IDENT (X : T) RETURN T IS
103
     BEGIN
104
          IF EQUAL (X'LENGTH, X'LENGTH) THEN
105
               RETURN X;                          -- ALWAYS EXECUTED.
106
          END IF;
107
          RETURN (OTHERS => '-');
108
     END IDENT;
109
 
110
BEGIN
111
     TEST ("C34005G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
112
                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
113
                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
114
                      "TYPE IS A CHARACTER TYPE");
115
 
116
     X := IDENT ("ABC");
117
     IF X /= "ABC" THEN
118
          FAILED ("INCORRECT :=");
119
     END IF;
120
 
121
     IF T'(X) /= "ABC" THEN
122
          FAILED ("INCORRECT QUALIFICATION");
123
     END IF;
124
 
125
     IF T (X) /= "ABC" THEN
126
          FAILED ("INCORRECT SELF CONVERSION");
127
     END IF;
128
 
129
     IF EQUAL (3, 3) THEN
130
          W := "ABC";
131
     END IF;
132
     IF T (W) /= "ABC" THEN
133
          FAILED ("INCORRECT CONVERSION FROM PARENT");
134
     END IF;
135
 
136
     BEGIN
137
          IF PARENT (X) /= "ABC" OR
138
             PARENT (CREATE (2, 3, 'D', X)) /= "DE" THEN
139
               FAILED ("INCORRECT CONVERSION TO PARENT");
140
          END IF;
141
     EXCEPTION
142
          WHEN CONSTRAINT_ERROR =>
143
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
144
          WHEN OTHERS =>
145
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
146
     END;
147
 
148
     IF EQUAL (3, 3) THEN
149
          U := "ABC";
150
     END IF;
151
     IF T (U) /= "ABC" THEN
152
          FAILED ("INCORRECT CONVERSION FROM ARRAY");
153
     END IF;
154
 
155
     BEGIN
156
          IF ARR (X) /= "ABC" OR
157
             ARRT (CREATE (1, 2, 'C', X)) /= "CD" THEN
158
               FAILED ("INCORRECT CONVERSION TO ARRAY");
159
          END IF;
160
     EXCEPTION
161
          WHEN CONSTRAINT_ERROR =>
162
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
163
          WHEN OTHERS =>
164
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
165
     END;
166
 
167
     IF IDENT ("ABC") /= ('A', 'B', 'C') OR
168
        X = "AB" THEN
169
          FAILED ("INCORRECT STRING LITERAL");
170
     END IF;
171
 
172
     IF IDENT (('A', 'B', 'C')) /= "ABC" OR
173
        X = ('A', 'B') THEN
174
          FAILED ("INCORRECT AGGREGATE");
175
     END IF;
176
 
177
     BEGIN
178
          IF X (IDENT_INT (5)) /= 'A' OR
179
             CREATE (2, 3, 'D', X) (3) /= 'E' THEN
180
               FAILED ("INCORRECT INDEX (VALUE)");
181
          END IF;
182
     EXCEPTION
183
          WHEN CONSTRAINT_ERROR =>
184
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
185
          WHEN OTHERS =>
186
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
187
     END;
188
 
189
     X (IDENT_INT (7)) := 'D';
190
     IF X /= "ABD" THEN
191
          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
192
     END IF;
193
 
194
     BEGIN
195
          X := IDENT ("ABC");
196
          IF X (IDENT_INT (6) .. IDENT_INT (7)) /= "BC" OR
197
             CREATE (1, 4, 'D', X) (1 .. 3) /= "DEF" THEN
198
               FAILED ("INCORRECT SLICE (VALUE)");
199
          END IF;
200
     EXCEPTION
201
          WHEN CONSTRAINT_ERROR =>
202
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
203
          WHEN OTHERS =>
204
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
205
     END;
206
 
207
     X (IDENT_INT (5) .. IDENT_INT (6)) := "DE";
208
     IF X /= "DEC" THEN
209
          FAILED ("INCORRECT SLICE (ASSIGNMENT)");
210
     END IF;
211
 
212
     X := IDENT ("ABC");
213
     IF X = IDENT ("ABD") OR X = "AB" THEN
214
          FAILED ("INCORRECT =");
215
     END IF;
216
 
217
     IF X /= IDENT ("ABC") OR NOT (X /= "BC") THEN
218
          FAILED ("INCORRECT /=");
219
     END IF;
220
 
221
     IF X < IDENT ("ABC") OR X < "AB" THEN
222
          FAILED ("INCORRECT <");
223
     END IF;
224
 
225
     IF X > IDENT ("ABC") OR X > "AC" THEN
226
          FAILED ("INCORRECT >");
227
     END IF;
228
 
229
     IF X <= IDENT ("ABB") OR X <= "ABBD" THEN
230
          FAILED ("INCORRECT <=");
231
     END IF;
232
 
233
     IF X >= IDENT ("ABD") OR X >= "ABCA" THEN
234
          FAILED ("INCORRECT >=");
235
     END IF;
236
 
237
     IF NOT (X IN T) OR "AB" IN T THEN
238
          FAILED ("INCORRECT ""IN""");
239
     END IF;
240
 
241
     IF X NOT IN T OR NOT ("AB" NOT IN T) THEN
242
          FAILED ("INCORRECT ""NOT IN""");
243
     END IF;
244
 
245
     BEGIN
246
          IF X & "DEF" /= "ABCDEF" OR
247
             CREATE (2, 3, 'B', X) & "DE" /= "BCDE" THEN
248
               FAILED ("INCORRECT & (ARRAY, ARRAY)");
249
          END IF;
250
     EXCEPTION
251
          WHEN CONSTRAINT_ERROR =>
252
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
253
          WHEN OTHERS =>
254
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
255
     END;
256
 
257
     BEGIN
258
          IF X & 'D' /= "ABCD" OR
259
             CREATE (2, 3, 'B', X) & 'D' /= "BCD" THEN
260
               FAILED ("INCORRECT & (ARRAY, COMPONENT)");
261
          END IF;
262
     EXCEPTION
263
          WHEN CONSTRAINT_ERROR =>
264
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
265
          WHEN OTHERS =>
266
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
267
     END;
268
 
269
     BEGIN
270
          IF 'D' & X /= "DABC" OR
271
             'B' & CREATE (2, 3, 'C', X) /= "BCD" THEN
272
               FAILED ("INCORRECT & (COMPONENT, ARRAY)");
273
          END IF;
274
     EXCEPTION
275
          WHEN CONSTRAINT_ERROR =>
276
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
277
          WHEN OTHERS =>
278
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
279
     END;
280
 
281
     IF EQUAL (3, 3) THEN
282
          C := 'B';
283
     END IF;
284
 
285
     BEGIN
286
          IF C & 'C' /= CREATE (2, 3, 'B', X) THEN
287
               FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
288
          END IF;
289
     EXCEPTION
290
          WHEN CONSTRAINT_ERROR =>
291
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
292
          WHEN OTHERS =>
293
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
294
     END;
295
 
296
     B := FALSE;
297
     A (X'ADDRESS);
298
     IF NOT B THEN
299
          FAILED ("INCORRECT 'ADDRESS");
300
     END IF;
301
 
302
     IF T'FIRST /= 5 THEN
303
          FAILED ("INCORRECT TYPE'FIRST");
304
     END IF;
305
 
306
     IF X'FIRST /= 5 THEN
307
          FAILED ("INCORRECT OBJECT'FIRST");
308
     END IF;
309
 
310
     IF V'FIRST /= 5 THEN
311
          FAILED ("INCORRECT VALUE'FIRST");
312
     END IF;
313
 
314
     IF T'FIRST (N) /= 5 THEN
315
          FAILED ("INCORRECT TYPE'FIRST (N)");
316
     END IF;
317
 
318
     IF X'FIRST (N) /= 5 THEN
319
          FAILED ("INCORRECT OBJECT'FIRST (N)");
320
     END IF;
321
 
322
     IF V'FIRST (N) /= 5 THEN
323
          FAILED ("INCORRECT VALUE'FIRST (N)");
324
     END IF;
325
 
326
     IF T'LAST /= 7 THEN
327
          FAILED ("INCORRECT TYPE'LAST");
328
     END IF;
329
 
330
     IF X'LAST /= 7 THEN
331
          FAILED ("INCORRECT OBJECT'LAST");
332
     END IF;
333
 
334
     IF V'LAST /= 7 THEN
335
          FAILED ("INCORRECT VALUE'LAST");
336
     END IF;
337
 
338
     IF T'LAST (N) /= 7 THEN
339
          FAILED ("INCORRECT TYPE'LAST (N)");
340
     END IF;
341
 
342
     IF X'LAST (N) /= 7 THEN
343
          FAILED ("INCORRECT OBJECT'LAST (N)");
344
     END IF;
345
 
346
     IF V'LAST (N) /= 7 THEN
347
          FAILED ("INCORRECT VALUE'LAST (N)");
348
     END IF;
349
 
350
     IF T'LENGTH /= 3 THEN
351
          FAILED ("INCORRECT TYPE'LENGTH");
352
     END IF;
353
 
354
     IF X'LENGTH /= 3 THEN
355
          FAILED ("INCORRECT OBJECT'LENGTH");
356
     END IF;
357
 
358
     IF V'LENGTH /= 3 THEN
359
          FAILED ("INCORRECT VALUE'LENGTH");
360
     END IF;
361
 
362
     IF T'LENGTH (N) /= 3 THEN
363
          FAILED ("INCORRECT TYPE'LENGTH (N)");
364
     END IF;
365
 
366
     IF X'LENGTH (N) /= 3 THEN
367
          FAILED ("INCORRECT OBJECT'LENGTH (N)");
368
     END IF;
369
 
370
     IF V'LENGTH (N) /= 3 THEN
371
          FAILED ("INCORRECT VALUE'LENGTH (N)");
372
     END IF;
373
 
374
     DECLARE
375
          Y : PARENT (T'RANGE);
376
     BEGIN
377
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
378
               FAILED ("INCORRECT TYPE'RANGE");
379
          END IF;
380
     END;
381
 
382
     DECLARE
383
          Y : PARENT (X'RANGE);
384
     BEGIN
385
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
386
               FAILED ("INCORRECT OBJECT'RANGE");
387
          END IF;
388
     END;
389
 
390
     DECLARE
391
          Y : PARENT (V'RANGE);
392
     BEGIN
393
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
394
               FAILED ("INCORRECT VALUE'RANGE");
395
          END IF;
396
     END;
397
 
398
     DECLARE
399
          Y : PARENT (T'RANGE (N));
400
     BEGIN
401
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
402
               FAILED ("INCORRECT TYPE'RANGE (N)");
403
          END IF;
404
     END;
405
 
406
     DECLARE
407
          Y : PARENT (X'RANGE (N));
408
     BEGIN
409
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
410
               FAILED ("INCORRECT OBJECT'RANGE (N)");
411
          END IF;
412
     END;
413
 
414
     DECLARE
415
          Y : PARENT (V'RANGE (N));
416
     BEGIN
417
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
418
               FAILED ("INCORRECT VALUE'RANGE (N)");
419
          END IF;
420
     END;
421
 
422
     RESULT;
423
END C34005G;

powered by: WebSVN 2.1.0

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