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/] [c36104a.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 
-- C36104A.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,
29 
-- WHERE 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 STATIC CASES ARE CHECKED HERE.
33 
 
34 
-- DAT 2/3/81
35 
-- JRK 2/25/81
36 
-- VKG 1/21/83
37 
-- L.BROWN  7/15/86  1) ADDED ACCESS TYPES.
38 
--                   2) DELETED "NULL INDEX RANGES, CONSTRAINT_ERROR
39 
--                      RAISED" SECTION.
40 
--                   3) DELETED ANY MENTION OF CASE STATEMENT CHOICES
41 
--                      AND VARIANT CHOICES IN THE ABOVE COMMENT.
42 
-- EDS      7/16/98  AVOID OPTIMIZATION
43 
 
44 
WITH REPORT;
45 
PROCEDURE C36104A IS
46 
 
47 
     USE REPORT;
48 
 
49 
     TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
50 
     TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK;
51 
     SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI;
52 
     SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU;
53 
 
54 
     TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10;
55 
     TYPE I_10 IS NEW INT_10;
56 
     SUBTYPE I_5 IS I_10 RANGE -5 .. 5;
57 
     TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5;
58 
 
59 
BEGIN
60 
     TEST ("C36104A", "CONSTRAINT_ERROR IS RAISED OR NOT IN STATIC "
61 
          & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
62 
 
63 
     -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
64 
 
65 
     BEGIN
66 
          DECLARE
67 
               TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5;
68 
               -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
69 
          BEGIN
70 
               DECLARE
71 
                  -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID
72 
                  -- OPTIMIZATION OF SUBTYPE
73 
                  A1 : A := (OTHERS => I_5(IDENT_INT(1)));
74 
               BEGIN
75 
                  FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " &
76 
                          I_5'IMAGE(A1(1)) );  --USE A1
77 
               END;
78 
          EXCEPTION
79 
             --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
80 
             --REPORT FAILED.
81 
             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1");
82 
          END;
83 
     EXCEPTION
84 
          WHEN CONSTRAINT_ERROR => NULL;
85 
          WHEN OTHERS =>
86 
                FAILED ("WRONG EXCEPTION RAISED 1");
87 
     END;
88 
 
89 
     BEGIN
90 
          FOR I IN MID_WEEK RANGE MON .. MON LOOP
91 
               FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
92 
          END LOOP;
93 
          FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
94 
     EXCEPTION
95 
          WHEN CONSTRAINT_ERROR => NULL;
96 
          WHEN OTHERS =>
97 
               FAILED ("WRONG EXCEPTION RAISED 3");
98 
     END;
99 
 
100 
     BEGIN
101 
          DECLARE
102 
               TYPE P IS ACCESS I_5_ARRAY (I_5 RANGE 0 .. 6);
103 
               -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
104 
          BEGIN
105 
             DECLARE
106 
                TYPE PA IS NEW P;
107 
                -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID
108 
                -- OPTIMIZATION OF TYPE
109 
                PA1 : PA := NEW I_5_ARRAY'(0 .. I_5(IDENT_INT(6)) =>
110 
                                           I_5(IDENT_INT(1)));
111 
             BEGIN
112 
                FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " &
113 
                        I_5'IMAGE(PA1(1))); --USE PA1
114 
             END;
115 
          EXCEPTION
116 
             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
117 
          END;
118 
     EXCEPTION
119 
          WHEN CONSTRAINT_ERROR => NULL;
120 
          WHEN OTHERS =>
121 
               FAILED ("WRONG EXCEPTION RAISED 4");
122 
     END;
123 
 
124 
     DECLARE
125 
          W : WEEK_ARRAY (MID_WEEK);
126 
     BEGIN
127 
          W := (MID_WEEK RANGE MON .. WED => WED);
128 
          -- CONSTRAINT_ERROR RAISED.
129 
          FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " &
130 
                  MID_WEEK'IMAGE(W(WED))); --USE W
131 
     EXCEPTION
132 
          WHEN CONSTRAINT_ERROR => NULL;
133 
          WHEN OTHERS =>
134 
               FAILED ("WRONG EXCEPTION RAISED 7");
135 
     END;
136 
 
137 
     DECLARE
138 
          W : WEEK_ARRAY (WORK_WEEK);
139 
     BEGIN
140 
          W := (W'RANGE => WED); -- OK.
141 
          W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
142 
          FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " &
143 
                  MID_WEEK'IMAGE(W(WED))); --USE W
144 
     EXCEPTION
145 
          WHEN CONSTRAINT_ERROR => NULL;
146 
          WHEN OTHERS =>
147 
               FAILED ("WRONG EXCEPTION RAISED 8");
148 
     END;
149 
 
150 
     BEGIN
151 
          DECLARE
152 
               W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
153 
               -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
154 
          BEGIN
155 
               W := (W'RANGE => WED); -- OK.
156 
               FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " &
157 
                       MID_WEEK'IMAGE(W(WED))); --USE W
158 
          EXCEPTION
159 
               WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 9");
160 
          END;
161 
     EXCEPTION
162 
          WHEN CONSTRAINT_ERROR => NULL;
163 
          WHEN OTHERS =>
164 
               FAILED ("WRONG EXCEPTION RAISED 9");
165 
     END;
166 
 
167 
     BEGIN
168 
          DECLARE
169 
               TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. TUE);
170 
               -- RAISES CONSTRAINT_ERROR.
171 
          BEGIN
172 
             DECLARE
173 
                W1 : W := (OTHERS => WED);
174 
             BEGIN
175 
                FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " &
176 
                        MID_WEEK'IMAGE(W1(WED))); --USE W1
177 
             END;
178 
          EXCEPTION
179 
             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 10");
180 
          END;
181 
     EXCEPTION
182 
          WHEN CONSTRAINT_ERROR => NULL;
183 
          WHEN OTHERS =>
184 
               FAILED ("WRONG EXCEPTION RAISED 10");
185 
     END;
186 
 
187 
     BEGIN
188 
          DECLARE
189 
               SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. WED);
190 
               -- RAISES CONSTRAINT_ERROR.
191 
          BEGIN
192 
               DECLARE
193 
                    W1 : W := (OTHERS => (WED));
194 
               BEGIN
195 
                    FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " &
196 
                            MID_WEEK'IMAGE(W1(WED))); --USE W1
197 
               END;
198 
          EXCEPTION
199 
               WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
200 
          END;
201 
     EXCEPTION
202 
          WHEN CONSTRAINT_ERROR => NULL;
203 
          WHEN OTHERS =>
204 
               FAILED ("WRONG EXCEPTION RAISED 11");
205 
     END;
206 
 
207 
     -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
208 
 
209 
     BEGIN
210 
          DECLARE
211 
               TYPE A IS ARRAY (I_5 RANGE -5 .. -6) OF I_5;
212 
               A1 : A;
213 
          BEGIN
214 
               IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
215 
                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
216 
               END IF;
217 
          END;
218 
     EXCEPTION
219 
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
220 
     END;
221 
 
222 
     BEGIN
223 
          FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
224 
               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
225 
          END LOOP;
226 
          FOR I IN MID_WEEK RANGE FRI .. WED LOOP
227 
               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
228 
          END LOOP;
229 
          FOR I IN MID_WEEK RANGE MON .. SUN LOOP
230 
               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
231 
          END LOOP;
232 
          FOR I IN I_5 RANGE 10 .. -10 LOOP
233 
               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
234 
          END LOOP;
235 
          FOR I IN I_5 RANGE 10 .. 9 LOOP
236 
               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
237 
          END LOOP;
238 
          FOR I IN I_5 RANGE -10 .. -11 LOOP
239 
               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
240 
          END LOOP;
241 
          FOR I IN I_5 RANGE -10 .. -20 LOOP
242 
               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
243 
          END LOOP;
244 
          FOR I IN I_5 RANGE 6 .. 5 LOOP
245 
               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
246 
          END LOOP;
247 
     EXCEPTION
248 
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
249 
     END;
250 
 
251 
     BEGIN
252 
          DECLARE
253 
               TYPE P IS ACCESS I_5_ARRAY (-5 .. -6);
254 
               PA1 : P := NEW I_5_ARRAY (-5 .. -6);
255 
          BEGIN
256 
               IF PA1'LENGTH /= IDENT_INT(0) THEN
257 
                    FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
258 
               END IF;
259 
          END;
260 
     EXCEPTION
261 
          WHEN OTHERS =>
262 
               FAILED ("EXCEPTION RAISED 5");
263 
     END;
264 
 
265 
     DECLARE
266 
          TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
267 
          SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
268 
          W : NARR(SNARR) := (1,2);
269 
     BEGIN
270 
          IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
271 
               FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
272 
          END IF;
273 
     EXCEPTION
274 
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
275 
     END;
276 
 
277 
     DECLARE
278 
          W : WEEK_ARRAY (MID_WEEK);
279 
     BEGIN
280 
          W := (W'RANGE => WED); -- OK.
281 
          W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
282 
     EXCEPTION
283 
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
284 
     END;
285 
 
286 
     BEGIN
287 
          DECLARE
288 
               W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
289 
          BEGIN
290 
               IF (W'FIRST /= MON) THEN
291 
                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
292 
               END IF;
293 
          END;
294 
     EXCEPTION
295 
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
296 
     END;
297 
 
298 
     BEGIN
299 
          DECLARE
300 
               TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
301 
               W1 : W;
302 
          BEGIN
303 
               IF (W1'FIRST /= TUE) THEN
304 
                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
305 
               END IF;
306 
          END;
307 
     EXCEPTION
308 
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
309 
     END;
310 
 
311 
     BEGIN
312 
          DECLARE
313 
               SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
314 
               W1 : W;
315 
          BEGIN
316 
               IF (W1'FIRST /= TUE) THEN
317 
                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
318 
               END IF;
319 
          END;
320 
     EXCEPTION
321 
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 12");
322 
     END;
323 
 
324 
     -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
325 
 
326 
     BEGIN
327 
          IF SUN IN  SAT .. SUN
328 
          OR SAT IN  FRI .. WED
329 
          OR WED IN  THU .. TUE
330 
          OR THU IN  MON .. SUN
331 
          OR FRI IN  SAT .. FRI
332 
          OR WED IN  FRI .. MON
333 
          THEN
334 
               FAILED ("INCORRECT 'IN' EVALUATION 1");
335 
          END IF;
336 
 
337 
          IF INTEGER'(0) IN  10 .. -10
338 
          OR INTEGER'(0) IN  10 .. 9
339 
          OR INTEGER'(0) IN  -10 .. -11
340 
          OR INTEGER'(0) IN  -10 .. -20
341 
          OR INTEGER'(0) IN  6 .. 5
342 
          OR INTEGER'(0) IN  5 .. 3
343 
          OR INTEGER'(0) IN  7 .. 3
344 
          THEN
345 
               FAILED ("INCORRECT 'IN' EVALUATION 2");
346 
          END IF;
347 
 
348 
          IF WED NOT IN  THU .. TUE
349 
          AND INTEGER'(0) NOT IN  4 .. -4
350 
          THEN NULL;
351 
          ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION");
352 
          END IF;
353 
     EXCEPTION
354 
          WHEN OTHERS => FAILED ("EXCEPTION RAISED 52");
355 
     END;
356 
 
357 
 
358 
     RESULT;
359 
END C36104A;

powered by: WebSVN 2.1.0

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