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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C34005J.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 BOOLEAN TYPE.
29
 
30
-- HISTORY:
31
--     JRK 9/16/86  CREATED ORIGINAL TEST.
32
--     RJW 8/21/89  MODIFIED CHECKS FOR TYPE AND OBJECT SIZES.
33
--     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
34
 
35
WITH SYSTEM; USE SYSTEM;
36
WITH REPORT; USE REPORT;
37
 
38
PROCEDURE C34005J IS
39
 
40
     SUBTYPE COMPONENT IS BOOLEAN;
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 => TRUE);
66
     W : PARENT (5 .. 7) := (OTHERS => TRUE);
67
     C : COMPONENT       := FALSE;
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 := NOT 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 => FALSE);
108
     END IDENT;
109
 
110
BEGIN
111
     TEST ("C34005J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
112
                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
113
                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
114
                      "TYPE IS A BOOLEAN TYPE");
115
 
116
     X := IDENT ((TRUE, FALSE, TRUE));
117
     IF X /= (TRUE, FALSE, TRUE) THEN
118
          FAILED ("INCORRECT :=");
119
     END IF;
120
 
121
     IF T'(X) /= (TRUE, FALSE, TRUE) THEN
122
          FAILED ("INCORRECT QUALIFICATION");
123
     END IF;
124
 
125
     IF T (X) /= (TRUE, FALSE, TRUE) THEN
126
          FAILED ("INCORRECT SELF CONVERSION");
127
     END IF;
128
 
129
     IF EQUAL (3, 3) THEN
130
          W := (TRUE, FALSE, TRUE);
131
     END IF;
132
     IF T (W) /= (TRUE, FALSE, TRUE) THEN
133
          FAILED ("INCORRECT CONVERSION FROM PARENT");
134
     END IF;
135
 
136
     BEGIN
137
          IF PARENT (X) /= (TRUE, FALSE, TRUE) OR
138
             PARENT (CREATE (2, 3, FALSE, X)) /= (FALSE, TRUE) 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 := (TRUE, FALSE, TRUE);
150
     END IF;
151
     IF T (U) /= (TRUE, FALSE, TRUE) THEN
152
          FAILED ("INCORRECT CONVERSION FROM ARRAY");
153
     END IF;
154
 
155
     BEGIN
156
          IF ARR (X) /= (TRUE, FALSE, TRUE) OR
157
             ARRT (CREATE (1, 2, TRUE, X)) /= (TRUE, FALSE) 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 ((TRUE, FALSE, TRUE)) /= (TRUE, FALSE, TRUE) OR
168
        X = (TRUE, FALSE) THEN
169
          FAILED ("INCORRECT AGGREGATE");
170
     END IF;
171
 
172
     BEGIN
173
          IF X (IDENT_INT (5)) /= TRUE OR
174
             CREATE (2, 3, FALSE, X) (3) /= TRUE THEN
175
               FAILED ("INCORRECT INDEX (VALUE)");
176
          END IF;
177
     EXCEPTION
178
          WHEN CONSTRAINT_ERROR =>
179
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
180
          WHEN OTHERS =>
181
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
182
     END;
183
 
184
     X (IDENT_INT (7)) := FALSE;
185
     IF X /= (TRUE, FALSE, FALSE) THEN
186
          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
187
     END IF;
188
 
189
     BEGIN
190
          X := IDENT ((TRUE, FALSE, TRUE));
191
          IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (FALSE, TRUE) OR
192
             CREATE (1, 4, FALSE, X) (1 .. 3) /=
193
             (FALSE, TRUE, FALSE) THEN
194
               FAILED ("INCORRECT SLICE (VALUE)");
195
          END IF;
196
     EXCEPTION
197
          WHEN CONSTRAINT_ERROR =>
198
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
199
          WHEN OTHERS =>
200
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
201
     END;
202
 
203
     X (IDENT_INT (5) .. IDENT_INT (6)) := (FALSE, TRUE);
204
     IF X /= (FALSE, TRUE, TRUE) THEN
205
          FAILED ("INCORRECT SLICE (ASSIGNMENT)");
206
     END IF;
207
 
208
     BEGIN
209
          X := IDENT ((TRUE, FALSE, TRUE));
210
          IF NOT X /= (FALSE, TRUE, FALSE) OR
211
             NOT CREATE (2, 3, FALSE, X) /= (TRUE, FALSE) THEN
212
               FAILED ("INCORRECT ""NOT""");
213
          END IF;
214
     EXCEPTION
215
          WHEN CONSTRAINT_ERROR =>
216
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
217
          WHEN OTHERS =>
218
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
219
     END;
220
 
221
     BEGIN
222
          IF (X AND IDENT ((TRUE, TRUE, FALSE))) /=
223
             (TRUE, FALSE, FALSE) OR
224
             (CREATE (1, 4, FALSE, X) AND
225
             (FALSE, FALSE, TRUE, TRUE)) /=
226
             (FALSE, FALSE, FALSE, TRUE) THEN
227
               FAILED ("INCORRECT ""AND""");
228
          END IF;
229
     EXCEPTION
230
          WHEN CONSTRAINT_ERROR =>
231
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
232
          WHEN OTHERS =>
233
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
234
     END;
235
 
236
     BEGIN
237
          IF (X OR IDENT ((TRUE, FALSE, FALSE))) /=
238
             (TRUE, FALSE, TRUE) OR
239
             (CREATE (1, 4, FALSE, X) OR (FALSE, FALSE, TRUE, TRUE)) /=
240
             (FALSE, TRUE, TRUE, TRUE) THEN
241
               FAILED ("INCORRECT ""OR""");
242
          END IF;
243
     EXCEPTION
244
          WHEN CONSTRAINT_ERROR =>
245
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
246
          WHEN OTHERS =>
247
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
248
     END;
249
 
250
     BEGIN
251
          IF (X XOR IDENT ((TRUE, TRUE, FALSE))) /=
252
             (FALSE, TRUE, TRUE) OR
253
             (CREATE (1, 4, FALSE, X) XOR
254
             (FALSE, FALSE, TRUE, TRUE)) /=
255
             (FALSE, TRUE, TRUE, FALSE) THEN
256
               FAILED ("INCORRECT ""XOR""");
257
          END IF;
258
     EXCEPTION
259
          WHEN CONSTRAINT_ERROR =>
260
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
261
          WHEN OTHERS =>
262
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
263
     END;
264
 
265
     IF X = IDENT ((TRUE, FALSE, FALSE)) OR X = (TRUE, FALSE) THEN
266
          FAILED ("INCORRECT =");
267
     END IF;
268
 
269
     IF X /= IDENT ((TRUE, FALSE, TRUE)) OR
270
        NOT (X /= (FALSE, TRUE)) THEN
271
          FAILED ("INCORRECT /=");
272
     END IF;
273
 
274
     IF X < IDENT ((TRUE, FALSE, TRUE)) OR X < (TRUE, FALSE) THEN
275
          FAILED ("INCORRECT <");
276
     END IF;
277
 
278
     IF X > IDENT ((TRUE, FALSE, TRUE)) OR X > (TRUE, TRUE) THEN
279
          FAILED ("INCORRECT >");
280
     END IF;
281
 
282
     IF X <= IDENT ((TRUE, FALSE, FALSE)) OR
283
        X <= (TRUE, FALSE, FALSE, TRUE) THEN
284
          FAILED ("INCORRECT <=");
285
     END IF;
286
 
287
     IF X >= IDENT ((TRUE, TRUE, FALSE)) OR
288
        X >= (TRUE, FALSE, TRUE, FALSE) THEN
289
          FAILED ("INCORRECT >=");
290
     END IF;
291
 
292
     IF NOT (X IN T) OR (TRUE, FALSE) IN T THEN
293
          FAILED ("INCORRECT ""IN""");
294
     END IF;
295
 
296
     IF X NOT IN T OR NOT ((TRUE, FALSE) NOT IN T) THEN
297
          FAILED ("INCORRECT ""NOT IN""");
298
     END IF;
299
 
300
     BEGIN
301
          IF X & (FALSE, TRUE, FALSE) /=
302
             (TRUE, FALSE, TRUE, FALSE, TRUE, FALSE) OR
303
             CREATE (2, 3, FALSE, X) & (FALSE, TRUE) /=
304
             (FALSE, TRUE, FALSE, TRUE) THEN
305
               FAILED ("INCORRECT & (ARRAY, ARRAY)");
306
          END IF;
307
     EXCEPTION
308
          WHEN CONSTRAINT_ERROR =>
309
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 9");
310
          WHEN OTHERS =>
311
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 9");
312
     END;
313
 
314
     BEGIN
315
          IF X & FALSE /= (TRUE, FALSE, TRUE, FALSE) OR
316
             CREATE (2, 3, FALSE, X) & FALSE /=
317
             (FALSE, TRUE, FALSE) THEN
318
               FAILED ("INCORRECT & (ARRAY, COMPONENT)");
319
          END IF;
320
     EXCEPTION
321
          WHEN CONSTRAINT_ERROR =>
322
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 10");
323
          WHEN OTHERS =>
324
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 10");
325
     END;
326
 
327
     BEGIN
328
          IF FALSE & X /= (FALSE, TRUE, FALSE, TRUE) OR
329
             FALSE & CREATE (2, 3, TRUE, X) /=
330
             (FALSE, TRUE, FALSE) THEN
331
               FAILED ("INCORRECT & (COMPONENT, ARRAY)");
332
          END IF;
333
     EXCEPTION
334
          WHEN CONSTRAINT_ERROR =>
335
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 11");
336
          WHEN OTHERS =>
337
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 11");
338
     END;
339
 
340
     IF EQUAL (3, 3) THEN
341
          C := FALSE;
342
     END IF;
343
 
344
     BEGIN
345
          IF C & TRUE /= CREATE (2, 3, FALSE, X) THEN
346
               FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
347
          END IF;
348
     EXCEPTION
349
          WHEN CONSTRAINT_ERROR =>
350
               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 12");
351
          WHEN OTHERS =>
352
               FAILED ("CALL TO CREATE RAISED EXCEPTION - 12");
353
     END;
354
 
355
     B := FALSE;
356
     A (X'ADDRESS);
357
     IF NOT B THEN
358
          FAILED ("INCORRECT 'ADDRESS");
359
     END IF;
360
 
361
     IF T'FIRST /= 5 THEN
362
          FAILED ("INCORRECT TYPE'FIRST");
363
     END IF;
364
 
365
     IF X'FIRST /= 5 THEN
366
          FAILED ("INCORRECT OBJECT'FIRST");
367
     END IF;
368
 
369
     IF V'FIRST /= 5 THEN
370
          FAILED ("INCORRECT VALUE'FIRST");
371
     END IF;
372
 
373
     IF T'FIRST (N) /= 5 THEN
374
          FAILED ("INCORRECT TYPE'FIRST (N)");
375
     END IF;
376
 
377
     IF X'FIRST (N) /= 5 THEN
378
          FAILED ("INCORRECT OBJECT'FIRST (N)");
379
     END IF;
380
 
381
     IF V'FIRST (N) /= 5 THEN
382
          FAILED ("INCORRECT VALUE'FIRST (N)");
383
     END IF;
384
 
385
     IF T'LAST /= 7 THEN
386
          FAILED ("INCORRECT TYPE'LAST");
387
     END IF;
388
 
389
     IF X'LAST /= 7 THEN
390
          FAILED ("INCORRECT OBJECT'LAST");
391
     END IF;
392
 
393
     IF V'LAST /= 7 THEN
394
          FAILED ("INCORRECT VALUE'LAST");
395
     END IF;
396
 
397
     IF T'LAST (N) /= 7 THEN
398
          FAILED ("INCORRECT TYPE'LAST (N)");
399
     END IF;
400
 
401
     IF X'LAST (N) /= 7 THEN
402
          FAILED ("INCORRECT OBJECT'LAST (N)");
403
     END IF;
404
 
405
     IF V'LAST (N) /= 7 THEN
406
          FAILED ("INCORRECT VALUE'LAST (N)");
407
     END IF;
408
 
409
     IF T'LENGTH /= 3 THEN
410
          FAILED ("INCORRECT TYPE'LENGTH");
411
     END IF;
412
 
413
     IF X'LENGTH /= 3 THEN
414
          FAILED ("INCORRECT OBJECT'LENGTH");
415
     END IF;
416
 
417
     IF V'LENGTH /= 3 THEN
418
          FAILED ("INCORRECT VALUE'LENGTH");
419
     END IF;
420
 
421
     IF T'LENGTH (N) /= 3 THEN
422
          FAILED ("INCORRECT TYPE'LENGTH (N)");
423
     END IF;
424
 
425
     IF X'LENGTH (N) /= 3 THEN
426
          FAILED ("INCORRECT OBJECT'LENGTH (N)");
427
     END IF;
428
 
429
     IF V'LENGTH (N) /= 3 THEN
430
          FAILED ("INCORRECT VALUE'LENGTH (N)");
431
     END IF;
432
 
433
     DECLARE
434
          Y : PARENT (T'RANGE);
435
     BEGIN
436
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
437
               FAILED ("INCORRECT TYPE'RANGE");
438
          END IF;
439
     END;
440
 
441
     DECLARE
442
          Y : PARENT (X'RANGE);
443
     BEGIN
444
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
445
               FAILED ("INCORRECT OBJECT'RANGE");
446
          END IF;
447
     END;
448
 
449
     DECLARE
450
          Y : PARENT (V'RANGE);
451
     BEGIN
452
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
453
               FAILED ("INCORRECT VALUE'RANGE");
454
          END IF;
455
     END;
456
 
457
     DECLARE
458
          Y : PARENT (T'RANGE (N));
459
     BEGIN
460
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
461
               FAILED ("INCORRECT TYPE'RANGE (N)");
462
          END IF;
463
     END;
464
 
465
     DECLARE
466
          Y : PARENT (X'RANGE (N));
467
     BEGIN
468
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
469
               FAILED ("INCORRECT OBJECT'RANGE (N)");
470
          END IF;
471
     END;
472
 
473
     DECLARE
474
          Y : PARENT (V'RANGE (N));
475
     BEGIN
476
          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
477
               FAILED ("INCORRECT VALUE'RANGE (N)");
478
          END IF;
479
     END;
480
 
481
     RESULT;
482
END C34005J;

powered by: WebSVN 2.1.0

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