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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C36104B.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 CONSTRAINT_ERROR IS RAISED OR NOT, AS APPROPRIATE,
26
-- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS,
27
-- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES,
28
-- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS, WHERE
29
-- AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE.
30
-- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT
31
-- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES.
32
-- ONLY DYNAMIC CASES ARE CHECKED HERE.
33
 
34
-- DAT 2/3/81
35
-- JRK 2/25/81
36
-- L.BROWN  7/15/86  1) ADDED ACCESS TYPES.
37
--                   2) DELETED "NULL INDEX RANGE, CONSTRAINT_ERROR
38
--                      RAISED" SECTION.
39
--                   3) MADE USE OF DYNAMIC-RESULT FUNCTIONS.
40
--                   4) DELETED ALL REFERENCES TO CASE STATEMENT CHOICES
41
--                      AND VARIANT PART CHOICES IN THE ABOVE COMMENT.
42
-- EDS      7/16/98  AVOID OPTIMIZATION
43
 
44
WITH REPORT;
45
PROCEDURE C36104B IS
46
 
47
     USE REPORT;
48
 
49
     TYPE WEEK IS (SSUN, SMON, STUE, SWED, STHU, SFRI, SSAT);
50
     SUN : WEEK := WEEK'VAL(IDENT_INT(0));
51
     MON : WEEK := WEEK'VAL(IDENT_INT(1));
52
     TUE : WEEK := WEEK'VAL(IDENT_INT(2));
53
     WED : WEEK := WEEK'VAL(IDENT_INT(3));
54
     THU : WEEK := WEEK'VAL(IDENT_INT(4));
55
     FRI : WEEK := WEEK'VAL(IDENT_INT(5));
56
     SAT : WEEK := WEEK'VAL(IDENT_INT(6));
57
     TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK;
58
     SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI;
59
     SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU;
60
 
61
     TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10;
62
     TYPE I_10 IS NEW INT_10;
63
     SUBTYPE I_5 IS I_10 RANGE I_10(IDENT_INT(-5)) ..
64
                               I_10(IDENT_INT(5));
65
     TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5;
66
 
67
     FUNCTION F(DAY : WEEK) RETURN WEEK IS
68
        BEGIN
69
          RETURN DAY;
70
        END;
71
 
72
BEGIN
73
     TEST ("C36104B", "CONSTRAINT_ERROR IS RAISED OR NOT IN DYNAMIC "
74
          & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
75
 
76
     -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
77
 
78
     BEGIN
79
          DECLARE
80
               TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5;
81
               -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
82
          BEGIN
83
               DECLARE
84
                  -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID 
85
                  -- OPTIMIZATION OF SUBTYPE
86
                  A1 : A := (A'RANGE => I_5(IDENT_INT(1)));
87
               BEGIN
88
                  FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " &
89
                          I_5'IMAGE(A1(1)) );  --USE A1
90
               END;
91
          EXCEPTION
92
             --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
93
             --REPORT FAILED.
94
             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1");
95
          END;
96
     EXCEPTION
97
          WHEN CONSTRAINT_ERROR => NULL;
98
          WHEN OTHERS =>
99
               FAILED ("WRONG EXCEPTION RAISED 1");
100
     END;
101
 
102
     BEGIN
103
          FOR I IN MID_WEEK RANGE MON .. MON LOOP
104
 
105
               IF EQUAL(2,2)  THEN
106
                    SAT := SSAT;
107
               END IF;
108
 
109
          END LOOP;
110
          FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
111
     EXCEPTION
112
          WHEN CONSTRAINT_ERROR => NULL;
113
          WHEN OTHERS =>
114
               FAILED ("WRONG EXCEPTION RAISED 3");
115
     END;
116
 
117
     BEGIN
118
          DECLARE
119
               TYPE P IS ACCESS I_5_ARRAY (0 .. 6);
120
               -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
121
          BEGIN
122
               DECLARE
123
                  TYPE PA IS NEW P;
124
                  -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID 
125
                  -- OPTIMIZATION OF TYPE
126
                  PA1 : PA :=NEW I_5_ARRAY'(0.. I_5(IDENT_INT(6)) =>
127
                                            I_5(IDENT_INT(1)));
128
               BEGIN
129
                  FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " &
130
                          I_5'IMAGE(PA1(1))); --USE PA1
131
               END;
132
          EXCEPTION
133
             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
134
          END;
135
     EXCEPTION
136
          WHEN CONSTRAINT_ERROR => NULL;
137
          WHEN OTHERS =>
138
               FAILED ("WRONG EXCEPTION RAISED 4");
139
     END;
140
 
141
     DECLARE
142
          W : WEEK_ARRAY (MID_WEEK);
143
     BEGIN
144
          W := (MID_WEEK RANGE MON .. WED => WED);
145
          -- CONSTRAINT_ERROR RAISED.
146
          BEGIN
147
               FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " &
148
                       MID_WEEK'IMAGE(W(WED))); --USE W
149
          EXCEPTION
150
               WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 7");
151
          END;
152
     EXCEPTION
153
          WHEN CONSTRAINT_ERROR => NULL;
154
          WHEN OTHERS =>
155
               FAILED ("WRONG EXCEPTION RAISED 7");
156
     END;
157
 
158
     DECLARE
159
          W : WEEK_ARRAY (WORK_WEEK);
160
     BEGIN
161
          W := (W'RANGE => WED); -- OK.
162
          W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
163
          BEGIN
164
               FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " &
165
                       MID_WEEK'IMAGE(W(WED))); --USE W
166
          EXCEPTION
167
               WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
168
          END;
169
     EXCEPTION
170
          WHEN CONSTRAINT_ERROR => NULL;
171
          WHEN OTHERS =>
172
               FAILED ("WRONG EXCEPTION RAISED 8");
173
     END;
174
 
175
     BEGIN
176
          DECLARE
177
               W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
178
               -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
179
          BEGIN
180
               W(WED) := THU;        -- OK.
181
               FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " &
182
                       WEEK'IMAGE(W(WED)));   -- USE W
183
          END;
184
     EXCEPTION
185
          WHEN CONSTRAINT_ERROR => NULL;
186
          WHEN OTHERS =>
187
               FAILED ("WRONG EXCEPTION RAISED 9");
188
     END;
189
 
190
     BEGIN
191
          DECLARE
192
               TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. WED);
193
               -- RAISES CONSTRAINT_ERROR.
194
          BEGIN
195
               DECLARE
196
                    X : W;              -- OK.
197
               BEGIN
198
                    X(TUE) := THU;   -- OK.
199
                    FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " &
200
                            WEEK'IMAGE(X(TUE)));   -- USE X
201
               END;
202
          EXCEPTION
203
               WHEN OTHERS =>
204
                    FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
205
          END;
206
     EXCEPTION
207
          WHEN CONSTRAINT_ERROR => NULL;
208
          WHEN OTHERS =>
209
               FAILED ("WRONG EXCEPTION RAISED 10");
210
     END;
211
 
212
     BEGIN
213
          DECLARE
214
               SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. THU);
215
               -- RAISES CONSTRAINT_ERROR.
216
          BEGIN
217
               DECLARE
218
                    T : W;               -- OK.
219
               BEGIN
220
                    T(TUE) := THU;    -- OK.
221
                    FAILED ("CONSTRAINT_ERROR NOT RAISED 11 " &
222
                            WEEK'IMAGE(T(TUE)));
223
               END;
224
          EXCEPTION
225
               WHEN OTHERS =>
226
                    FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
227
          END;
228
     EXCEPTION
229
          WHEN CONSTRAINT_ERROR => NULL;
230
          WHEN OTHERS =>
231
               FAILED ("WRONG EXCEPTION RAISED 11");
232
     END;
233
 
234
     -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
235
 
236
     BEGIN
237
          DECLARE
238
               TYPE A IS ARRAY (I_5 RANGE I_5(IDENT_INT(-5)) .. -6) OF I_5;
239
               A1 : A;
240
          BEGIN
241
               IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
242
                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
243
               END IF;
244
          END;
245
     EXCEPTION
246
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
247
     END;
248
 
249
     BEGIN
250
          FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
251
 
252
               IF EQUAL(2,2)  THEN
253
                    TUE := STUE;
254
               END IF;
255
 
256
          END LOOP;
257
          FOR I IN MID_WEEK RANGE FRI .. WED LOOP
258
 
259
               IF EQUAL(2,2)  THEN
260
                    MON := SMON;
261
               END IF;
262
 
263
          END LOOP;
264
          FOR I IN MID_WEEK RANGE MON .. SUN LOOP
265
 
266
               IF EQUAL(3,3)  THEN
267
                    WED := SWED;
268
               END IF;
269
 
270
          END LOOP;
271
          FOR I IN I_5 RANGE 10 .. -10 LOOP
272
 
273
               IF EQUAL(2,2)  THEN
274
                    TUE := STUE;
275
               END IF;
276
 
277
          END LOOP;
278
          FOR I IN I_5 RANGE 10 .. 9 LOOP
279
 
280
               IF EQUAL(2,2)  THEN
281
                    THU := STHU;
282
               END IF;
283
 
284
          END LOOP;
285
          FOR I IN I_5 RANGE -10 .. -11 LOOP
286
 
287
               IF EQUAL(2,2)  THEN
288
                    SAT := SSAT;
289
               END IF;
290
 
291
          END LOOP;
292
          FOR I IN I_5 RANGE -10 .. -20 LOOP
293
 
294
               IF EQUAL(2,2)  THEN
295
                    SUN := SSUN;
296
               END IF;
297
 
298
          END LOOP;
299
          FOR I IN I_5 RANGE 6 .. 5 LOOP
300
 
301
               IF EQUAL(2,2)  THEN
302
                    MON := SMON;
303
               END IF;
304
 
305
          END LOOP;
306
     EXCEPTION
307
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
308
     END;
309
 
310
     BEGIN
311
          DECLARE
312
               TYPE P IS ACCESS I_5_ARRAY (I_5(IDENT_INT(-5)) .. -6);
313
               PA1 : P := NEW I_5_ARRAY (I_5(IDENT_INT(-5)) .. -6);
314
          BEGIN
315
               IF PA1'LENGTH /= IDENT_INT(0) THEN
316
                    FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
317
               END IF;
318
          END;
319
     EXCEPTION
320
          WHEN OTHERS =>
321
               FAILED ("EXCEPTION RAISED 5");
322
     END;
323
 
324
     DECLARE
325
          TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
326
          SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
327
          W : NARR(SNARR) := (1,2);
328
     BEGIN
329
          IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
330
               FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
331
          END IF;
332
     EXCEPTION
333
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
334
     END;
335
 
336
     DECLARE
337
          W : WEEK_ARRAY (MID_WEEK);
338
     BEGIN
339
          W := (W'RANGE => WED); -- OK.
340
          W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
341
     EXCEPTION
342
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
343
     END;
344
 
345
     BEGIN
346
          DECLARE
347
               W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
348
          BEGIN
349
 
350
               IF EQUAL(W'LENGTH,0)  THEN
351
                    TUE := STUE;
352
               END IF;
353
 
354
          END;
355
     EXCEPTION
356
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
357
     END;
358
 
359
     BEGIN
360
          DECLARE
361
               TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
362
          BEGIN
363
 
364
               IF EQUAL(W'LENGTH,0)  THEN
365
                    MON := SMON;
366
               END IF;
367
 
368
          END;
369
     EXCEPTION
370
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
371
     END;
372
 
373
     BEGIN
374
          DECLARE
375
               SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
376
          BEGIN
377
 
378
               IF EQUAL(W'LENGTH,0)  THEN
379
                    WED := SWED;
380
               END IF;
381
 
382
          END;
383
     EXCEPTION
384
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 12");
385
     END;
386
 
387
     -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
388
 
389
     BEGIN
390
          IF F(SUN) IN  SAT .. SUN
391
          OR SAT IN  FRI .. WED
392
          OR F(WED) IN  THU .. TUE
393
          OR THU IN  MON .. SUN
394
          OR F(FRI) IN  SAT .. FRI
395
          OR WED IN  FRI .. MON
396
          THEN
397
               FAILED ("INCORRECT 'IN' EVALUATION 1");
398
          END IF;
399
 
400
          IF IDENT_INT(0) IN  10 .. IDENT_INT(-10)
401
          OR 0 IN  IDENT_INT(10) .. 9
402
          OR IDENT_INT(0) IN  IDENT_INT(-10) .. -11
403
          OR 0 IN  -10 .. IDENT_INT(-20)
404
          OR IDENT_INT(0) IN  6 .. IDENT_INT(5)
405
          OR 0 IN  5 .. IDENT_INT(3)
406
          OR IDENT_INT(0) IN  7 .. IDENT_INT(3)
407
          THEN
408
               FAILED ("INCORRECT 'IN' EVALUATION 2");
409
          END IF;
410
 
411
          IF F(WED) NOT IN  THU .. TUE
412
          AND IDENT_INT(0) NOT IN  IDENT_INT(4) .. -4
413
          THEN NULL;
414
          ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION");
415
          END IF;
416
     EXCEPTION
417
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 52");
418
     END;
419
 
420
     RESULT;
421
END C36104B;

powered by: WebSVN 2.1.0

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