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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C34011B.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 A DERIVED TYPE DECLARATION IS NOT CONSIDERED EXACTLY
27 
--     EQUIVALENT TO AN ANONYMOUS DECLARATION OF THE DERIVED TYPE
28 
--     FOLLOWED BY A SUBTYPE DECLARATION OF THE DERIVED SUBTYPE.  IN
29 
--     PARTICULAR, CHECK THAT CONSTRAINT_ERROR CAN BE RAISED WHEN THE
30 
--     SUBTYPE INDICATION OF THE DERIVED TYPE DECLARATION IS ELABORATED
31 
--     (EVEN THOUGH THE CONSTRAINT WOULD SATISFY THE DERIVED (BASE)
32 
--     TYPE).
33 
 
34 
-- HISTORY:
35 
--     JRK 09/04/87  CREATED ORIGINAL TEST.
36 
--     EDS 07/29/98  AVOID OPTIMIZATION
37 
 
38 
WITH REPORT; USE REPORT;
39 
 
40 
PROCEDURE C34011B IS
41 
 
42 
     SUBTYPE BOOL IS BOOLEAN RANGE FALSE .. FALSE;
43 
 
44 
     SUBTYPE FLT IS FLOAT RANGE -10.0 .. 10.0;
45 
 
46 
     SUBTYPE DUR IS DURATION RANGE 0.0 .. 10.0;
47 
 
48 
     SUBTYPE INT IS INTEGER RANGE 0 .. 10;
49 
 
50 
     TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
51 
 
52 
     TYPE REC (D : INT := 0) IS
53 
          RECORD
54 
               I : INTEGER;
55 
          END RECORD;
56 
 
57 
     PACKAGE PT IS
58 
          TYPE PRIV (D : POSITIVE := 1) IS PRIVATE;
59 
     PRIVATE
60 
          TYPE PRIV (D : POSITIVE := 1) IS
61 
               RECORD
62 
                    I : INTEGER;
63 
               END RECORD;
64 
     END PT;
65 
 
66 
     USE PT;
67 
 
68 
     TYPE ACC_ARR IS ACCESS ARR;
69 
 
70 
     TYPE ACC_REC IS ACCESS REC;
71 
 
72 
BEGIN
73 
     TEST ("C34011B", "CHECK THAT CONSTRAINT_ERROR CAN BE RAISED " &
74 
                      "WHEN THE SUBTYPE INDICATION OF A DERIVED TYPE " &
75 
                      "DECLARATION IS ELABORATED");
76 
 
77 
     BEGIN
78 
          DECLARE
79 
            TYPE T IS NEW BOOL RANGE FALSE .. BOOL(IDENT_BOOL(TRUE));
80 
 
81 
          BEGIN
82 
            DECLARE
83 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
84 
               T1 : T := T(IDENT_BOOL(TRUE));
85 
            BEGIN
86 
               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
87 
            EXCEPTION
88 
               WHEN OTHERS =>
89 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
90 
                             " AT PROPER PLACE - BOOL " &
91 
                             T'IMAGE(T1) );   --USE T1);
92 
            END;
93 
 
94 
            FAILED ("EXCEPTION NOT RAISED - BOOL");
95 
 
96 
          EXCEPTION
97 
               WHEN OTHERS =>
98 
                    FAILED ("WRONG HANDLER ENTERED - BOOL");
99 
          END;
100 
 
101 
     EXCEPTION
102 
          WHEN CONSTRAINT_ERROR =>
103 
               NULL;
104 
          WHEN OTHERS =>
105 
               FAILED ("WRONG EXCEPTION RAISED - BOOL");
106 
     END;
107 
 
108 
     BEGIN
109 
          DECLARE
110 
            TYPE T IS NEW POSITIVE RANGE IDENT_INT (0) .. 10;
111 
 
112 
          BEGIN
113 
            DECLARE
114 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
115 
               T1 : T := T(IDENT_INT(1));
116 
            BEGIN
117 
                 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
118 
            EXCEPTION
119 
               WHEN OTHERS =>
120 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR - POSITIVE " &
121 
                             T'IMAGE(T1)); --USE T1
122 
            END;
123 
            FAILED ("EXCEPTION NOT RAISED - POSITIVE" );
124 
          EXCEPTION
125 
               WHEN OTHERS =>
126 
                    FAILED ("WRONG HANDLER ENTERED - POSITIVE");
127 
          END;
128 
 
129 
     EXCEPTION
130 
          WHEN CONSTRAINT_ERROR =>
131 
               NULL;
132 
          WHEN OTHERS =>
133 
               FAILED ("WRONG EXCEPTION RAISED - POSITIVE");
134 
     END;
135 
 
136 
     BEGIN
137 
          DECLARE
138 
            TYPE T IS NEW FLT RANGE 0.0 .. FLT(IDENT_INT(20));
139 
 
140 
          BEGIN
141 
            DECLARE
142 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
143 
               T1 : T := T(IDENT_INT(0));
144 
            BEGIN
145 
               FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
146 
                       " AT PROPER PLACE " &
147 
                       T'IMAGE(T1) ); --USE T1
148 
 
149 
            EXCEPTION
150 
               WHEN OTHERS =>
151 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
152 
                             " AT PROPER PLACE ");
153 
            END;
154 
            FAILED ("EXCEPTION NOT RAISED - FLT" );
155 
          EXCEPTION
156 
               WHEN OTHERS =>
157 
                    FAILED ("WRONG HANDLER ENTERED - FLT");
158 
          END;
159 
 
160 
     EXCEPTION
161 
          WHEN CONSTRAINT_ERROR =>
162 
               NULL;
163 
          WHEN OTHERS =>
164 
               FAILED ("WRONG EXCEPTION RAISED - FLT");
165 
     END;
166 
 
167 
     BEGIN
168 
          DECLARE
169 
            TYPE T IS NEW DUR RANGE DUR(IDENT_INT(-1)) .. 5.0;
170 
 
171 
 
172 
          BEGIN
173 
            DECLARE
174 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
175 
               T1 : T := T(IDENT_INT(2));
176 
            BEGIN
177 
               FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
178 
                       " AT PROPER PLACE " &
179 
                       T'IMAGE(T1) );  -- USE T1
180 
            EXCEPTION
181 
               WHEN OTHERS =>
182 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
183 
            END;
184 
            FAILED ("EXCEPTION NOT RAISED - DUR " );
185 
          EXCEPTION
186 
               WHEN OTHERS =>
187 
                    FAILED ("WRONG HANDLER ENTERED - DUR");
188 
          END;
189 
 
190 
     EXCEPTION
191 
          WHEN CONSTRAINT_ERROR =>
192 
               NULL;
193 
          WHEN OTHERS =>
194 
               FAILED ("WRONG EXCEPTION RAISED - DUR");
195 
     END;
196 
 
197 
     BEGIN
198 
          DECLARE
199 
            TYPE T IS NEW ARR (IDENT_INT (-1) .. 10);
200 
 
201 
          BEGIN
202 
            DECLARE
203 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
204 
               T1 : T := (OTHERS => IDENT_INT(3));
205 
            BEGIN
206 
               FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
207 
                       "AT PROPER PLACE " &
208 
                       INTEGER'IMAGE(T1(1)) ); --USE T1
209 
            EXCEPTION
210 
               WHEN OTHERS =>
211 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
212 
            END;
213 
            FAILED ("EXCEPTION NOT RAISED - ARR " );
214 
          EXCEPTION
215 
               WHEN OTHERS =>
216 
                    FAILED ("WRONG HANDLER ENTERED - ARR");
217 
          END;
218 
 
219 
     EXCEPTION
220 
          WHEN CONSTRAINT_ERROR =>
221 
               NULL;
222 
          WHEN OTHERS =>
223 
               FAILED ("WRONG EXCEPTION RAISED - ARR");
224 
     END;
225 
 
226 
     BEGIN
227 
          DECLARE
228 
               TYPE T IS NEW REC (IDENT_INT (11));
229 
 
230 
          BEGIN
231 
            DECLARE
232 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
233 
               T1 : T;
234 
            BEGIN
235 
               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
236 
            EXCEPTION
237 
               WHEN OTHERS =>
238 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
239 
                             "AT PROPER PLACE " &
240 
                             INTEGER'IMAGE(T1.D) ); --USE T1
241 
            END;
242 
            FAILED ("EXCEPTION NOT RAISED - REC " );
243 
          EXCEPTION
244 
               WHEN OTHERS =>
245 
                    FAILED ("WRONG HANDLER ENTERED - REC");
246 
          END;
247 
 
248 
     EXCEPTION
249 
          WHEN CONSTRAINT_ERROR =>
250 
               NULL;
251 
          WHEN OTHERS =>
252 
               FAILED ("WRONG EXCEPTION RAISED - REC");
253 
     END;
254 
 
255 
     BEGIN
256 
          DECLARE
257 
               TYPE T IS NEW PRIV (IDENT_INT (0));  --RAISES C_E
258 
 
259 
          BEGIN
260 
            DECLARE
261 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
262 
               T1 : T;
263 
            BEGIN
264 
               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
265 
            EXCEPTION
266 
               WHEN OTHERS =>
267 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
268 
                             "AT PROPER PLACE " &
269 
                             INTEGER'IMAGE(T1.D) ); --USE T1
270 
            END;
271 
            FAILED ("EXCEPTION NOT RAISED - PRIV " );
272 
          EXCEPTION
273 
               WHEN OTHERS =>
274 
                    FAILED ("WRONG HANDLER ENTERED - PRIV");
275 
          END;
276 
 
277 
     EXCEPTION
278 
          WHEN CONSTRAINT_ERROR =>
279 
               NULL;
280 
          WHEN OTHERS =>
281 
               FAILED ("WRONG EXCEPTION RAISED - PRIV");
282 
     END;
283 
 
284 
     BEGIN
285 
          DECLARE
286 
            TYPE T IS NEW ACC_ARR (0 .. IDENT_INT (11));  --RAISES C_E
287 
 
288 
          BEGIN
289 
            DECLARE
290 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
291 
               T1 : T;
292 
            BEGIN
293 
               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
294 
            EXCEPTION
295 
               WHEN OTHERS =>
296 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
297 
                             "AT PROPER PLACE " &
298 
                             INTEGER'IMAGE(T1(1)) ); --USE T1
299 
            END;
300 
            FAILED ("EXCEPTION NOT RAISED - ACC_ARR " );
301 
          EXCEPTION
302 
               WHEN OTHERS =>
303 
                    FAILED ("WRONG HANDLER ENTERED - ACC_ARR");
304 
          END;
305 
 
306 
     EXCEPTION
307 
          WHEN CONSTRAINT_ERROR =>
308 
               NULL;
309 
          WHEN OTHERS =>
310 
               FAILED ("WRONG EXCEPTION RAISED - ACC_ARR");
311 
     END;
312 
 
313 
     BEGIN
314 
          DECLARE
315 
               TYPE T IS NEW ACC_REC (IDENT_INT (-1));  --RAISES C_E
316 
 
317 
          BEGIN
318 
            DECLARE
319 
               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
320 
               T1 : T;
321 
            BEGIN
322 
               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
323 
            EXCEPTION
324 
               WHEN OTHERS =>
325 
                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
326 
                             "AT PROPER PLACE " &
327 
                             INTEGER'IMAGE(T1.D) ); --USE T1
328 
            END;
329 
                FAILED ("EXCEPTION NOT RAISED - ACC_REC " );
330 
          EXCEPTION
331 
               WHEN OTHERS =>
332 
                    FAILED ("WRONG HANDLER ENTERED - ACC_REC");
333 
          END;
334 
 
335 
     EXCEPTION
336 
          WHEN CONSTRAINT_ERROR =>
337 
               NULL;
338 
          WHEN OTHERS =>
339 
               FAILED ("WRONG EXCEPTION RAISED - ACC_REC");
340 
     END;
341 
 
342 
     RESULT;
343 
END C34011B;

powered by: WebSVN 2.1.0

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