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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 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.