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/] [c6/] [c64103b.ada] - Blame information for rev 297

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- C64103B.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, FOR IN-OUT PARAMETERS OF A SCALAR TYPE,
27 
--     CONSTRAINT_ERROR IS RAISED:
28 
--          BEFORE A SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL
29 
--          PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL PARAMETER'S
30 
--          SUBTYPE;
31 
--          AFTER A SUBPROGRAM CALL WHEN THE CONVERTED FORMAL PARAMETER
32 
--          IS OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S SUBTYPE.
33 
 
34 
-- HISTORY:
35 
--     CPP  07/18/84  CREATED ORIGINAL TEST.
36 
--     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
37 
--                    REFERENCED THE ACTUAL PARAMETERS IN THE SECOND
38 
--                    SUBTEST.
39 
 
40 
WITH REPORT;  USE REPORT;
41 
PROCEDURE C64103B IS
42 
BEGIN
43 
     TEST ("C64103B", "FOR IN-OUT PARAMETERS OF A SCALAR TYPE, " &
44 
                      "CONSTRAINT_ERROR IS RAISED:  BEFORE A " &
45 
                      "SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL " &
46 
                      "PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL " &
47 
                      "PARAMETER'S SUBTYPE;  AFTER A SUBPROGRAM " &
48 
                      "CALL WHEN THE CONVERTED FORMAL PARAMETER IS " &
49 
                      "OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S " &
50 
                      "SUBTYPE");
51 
 
52 
 
53 
     DECLARE
54 
          A0 : INTEGER := -9;
55 
          A1 : INTEGER := IDENT_INT(-1);
56 
          TYPE SUBINT IS RANGE -8 .. -2;
57 
 
58 
          TYPE FLOAT_TYPE IS DIGITS 3 RANGE 0.0 .. 3.0;
59 
          A2 : FLOAT_TYPE := 0.12;
60 
          A3 : FLOAT_TYPE := 2.5;
61 
          TYPE NEW_FLOAT IS DIGITS 3 RANGE 1.0 .. 2.0;
62 
 
63 
          TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0;
64 
          A4 : FIXED_TYPE := -2.0;
65 
          A5 : FIXED_TYPE := 4.0;
66 
          TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0;
67 
 
68 
          A6 : CHARACTER := 'A';
69 
          SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q';
70 
 
71 
          TYPE COLOR IS (RED, BURGUNDY, LILAC, MAROON, MAGENTA);
72 
          SUBTYPE A_COLOR IS COLOR RANGE RED..LILAC;
73 
          SUBTYPE B_COLOR IS COLOR RANGE MAROON..MAGENTA;
74 
          A7 : B_COLOR := MAROON;
75 
 
76 
          PROCEDURE P1 (X : IN OUT SUBINT;
77 
                        S :        STRING) IS
78 
          BEGIN
79 
               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (A" &
80 
                       S & ")");
81 
          END P1;
82 
 
83 
          PROCEDURE P2 (X : IN OUT NEW_FLOAT;
84 
                        S :        STRING)     IS
85 
          BEGIN
86 
               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P2 (A" &
87 
                       S & ")");
88 
          END P2;
89 
 
90 
          PROCEDURE P3 (X : IN OUT NEW_FIXED;
91 
                        S :        STRING)     IS
92 
          BEGIN
93 
               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P3 (A" &
94 
                       S & ")");
95 
          END P3;
96 
 
97 
          PROCEDURE P4 (X : IN OUT SUPER_CHAR;
98 
                        S :        STRING)     IS
99 
          BEGIN
100 
               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P4 (A" &
101 
                        S & ")");
102 
          END P4;
103 
 
104 
          PROCEDURE P5 (X : IN OUT A_COLOR;
105 
                        S :        STRING) IS
106 
          BEGIN
107 
               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P5 (A" &
108 
                       S & ")");
109 
          END P5;
110 
     BEGIN
111 
          BEGIN
112 
               P1 (SUBINT (A0), "1");
113 
          EXCEPTION
114 
               WHEN CONSTRAINT_ERROR =>
115 
                    NULL;
116 
               WHEN OTHERS =>
117 
                    FAILED ("WRONG EXCEPTION RAISED -P1 (A1)");
118 
          END;
119 
 
120 
          BEGIN
121 
               P1 (SUBINT (A1), "2");
122 
          EXCEPTION
123 
               WHEN CONSTRAINT_ERROR =>
124 
                    NULL;
125 
               WHEN OTHERS =>
126 
                    FAILED ("WRONG EXCEPTION RAISED -P1 (A2)");
127 
          END;
128 
 
129 
          BEGIN
130 
               P2 (NEW_FLOAT (A2), "1");
131 
          EXCEPTION
132 
               WHEN CONSTRAINT_ERROR =>
133 
                    NULL;
134 
               WHEN OTHERS =>
135 
                    FAILED ("WRONG EXCEPTION RAISED -P2 (A1)");
136 
          END;
137 
 
138 
          BEGIN
139 
               P2 (NEW_FLOAT (A3), "2");
140 
          EXCEPTION
141 
               WHEN CONSTRAINT_ERROR =>
142 
                    NULL;
143 
               WHEN OTHERS =>
144 
                    FAILED ("WRONG EXCEPTION RAISED -P2 (A2)");
145 
          END;
146 
 
147 
          BEGIN
148 
               P3 (NEW_FIXED (A4), "1");
149 
          EXCEPTION
150 
               WHEN CONSTRAINT_ERROR =>
151 
                    NULL;
152 
               WHEN OTHERS =>
153 
                    FAILED ("WRONG EXCEPTION RAISED -P3 (A1)");
154 
          END;
155 
 
156 
          BEGIN
157 
               P3 (NEW_FIXED (A5), "2");
158 
          EXCEPTION
159 
               WHEN CONSTRAINT_ERROR =>
160 
                    NULL;
161 
               WHEN OTHERS =>
162 
                    FAILED ("WRONG EXCEPTION RAISED -P3 (A2)");
163 
          END;
164 
 
165 
          BEGIN
166 
               P4 (SUPER_CHAR (A6),"1");
167 
          EXCEPTION
168 
               WHEN CONSTRAINT_ERROR =>
169 
                    NULL;
170 
               WHEN OTHERS =>
171 
                    FAILED ("WRONG EXCEPTION RAISED -P4 (A1)");
172 
          END;
173 
 
174 
          BEGIN
175 
               P5 (A_COLOR (A7), "1");
176 
          EXCEPTION
177 
               WHEN CONSTRAINT_ERROR =>
178 
                    NULL;
179 
               WHEN OTHERS =>
180 
                    FAILED ("WRONG EXCEPTION RAISED -P5 (A1)");
181 
          END;
182 
     END;
183 
 
184 
 
185 
     DECLARE
186 
          CALLED : BOOLEAN;
187 
          TYPE SUBINT IS RANGE -8 .. -2;
188 
          A0 : SUBINT := -3;
189 
          A1 : INTEGER := -9;
190 
          A2 : INTEGER := -1;
191 
 
192 
          TYPE FLOAT IS DIGITS 3 RANGE -1.0 .. 2.0;
193 
          TYPE A_FLOAT IS DIGITS 3 RANGE 0.0 .. 1.0;
194 
          A3 : A_FLOAT := 1.0;
195 
          A4 : FLOAT := -0.5;
196 
          A5 : FLOAT := 1.5;
197 
 
198 
          TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0;
199 
          A6 : NEW_FIXED := 0.0;
200 
          TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0;
201 
          A7 : FIXED_TYPE := -2.0;
202 
          A8 : FIXED_TYPE := 4.0;
203 
 
204 
          SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q';
205 
          A9  : SUPER_CHAR := 'C';
206 
          A10 : CHARACTER := 'A';
207 
          A11 : CHARACTER := 'R';
208 
 
209 
          PROCEDURE P1 (X : IN OUT INTEGER; Y : INTEGER) IS
210 
          BEGIN
211 
               CALLED := TRUE;
212 
               X := IDENT_INT (Y);
213 
          END P1;
214 
 
215 
          PROCEDURE P2 (X : IN OUT FLOAT; Y : FLOAT) IS
216 
          BEGIN
217 
               CALLED := TRUE;
218 
               X := Y;
219 
          END P2;
220 
 
221 
          PROCEDURE P3 ( X : IN OUT FIXED_TYPE; Y : FIXED_TYPE) IS
222 
          BEGIN
223 
               CALLED := TRUE;
224 
               X := Y;
225 
          END P3;
226 
 
227 
          PROCEDURE P4 (X : IN OUT CHARACTER; Y : CHARACTER) IS
228 
          BEGIN
229 
               CALLED := TRUE;
230 
               X := IDENT_CHAR(Y);
231 
          END P4;
232 
     BEGIN
233 
          BEGIN
234 
               CALLED := FALSE;
235 
               P1 (INTEGER(A0), A1);
236 
               IF A0 = -3 THEN
237 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B1)");
238 
               ELSE
239 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B2)");
240 
               END IF;
241 
          EXCEPTION
242 
               WHEN CONSTRAINT_ERROR =>
243 
                    IF NOT CALLED THEN
244 
                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
245 
                                 "-P1 (B1)");
246 
                    END IF;
247 
               WHEN OTHERS =>
248 
                    FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
249 
          END;
250 
 
251 
          BEGIN
252 
               CALLED := FALSE;
253 
               P1 (INTEGER(A0), A2);
254 
               IF A0 = -3 THEN
255 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B3)");
256 
               ELSE
257 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B4)");
258 
               END IF;
259 
          EXCEPTION
260 
               WHEN CONSTRAINT_ERROR =>
261 
                    IF NOT CALLED THEN
262 
                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
263 
                                 "-P1 (B2)");
264 
                    END IF;
265 
               WHEN OTHERS =>
266 
                    FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
267 
          END;
268 
 
269 
          BEGIN
270 
               CALLED := FALSE;
271 
               P2 (FLOAT (A3), A4);
272 
               IF A3 = 1.0 THEN
273 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B1)");
274 
               ELSE
275 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B2)");
276 
               END IF;
277 
          EXCEPTION
278 
               WHEN CONSTRAINT_ERROR =>
279 
                    IF NOT CALLED THEN
280 
                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
281 
                                 "-P2 (B1)");
282 
                    END IF;
283 
               WHEN OTHERS =>
284 
                    FAILED ("WRONG EXCEPTION RAISED -P2 (B1)");
285 
          END;
286 
 
287 
          BEGIN
288 
               CALLED := FALSE;
289 
               P2 (FLOAT (A3), A5);
290 
               IF A3 = 1.0 THEN
291 
                    FAILED ("EXCEPTION NOT RAISED -P2 (B3)");
292 
               ELSE
293 
                    FAILED ("EXCEPTION NOT RAISED -P2 (B4)");
294 
               END IF;
295 
          EXCEPTION
296 
               WHEN CONSTRAINT_ERROR =>
297 
                    IF NOT CALLED THEN
298 
                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
299 
                                 "-P2 (B2)");
300 
                    END IF;
301 
               WHEN OTHERS =>
302 
                    FAILED ("WRONG EXCEPTION RAISED -P2 (B2)");
303 
          END;
304 
 
305 
          BEGIN
306 
               CALLED := FALSE;
307 
               P3 (FIXED_TYPE (A6), A7);
308 
               IF A6 = 0.0 THEN
309 
                    FAILED ("EXCEPTION NOT RAISED -P3 (B1)");
310 
               ELSE
311 
                    FAILED ("EXCEPTION NOT RAISED -P3 (B2)");
312 
               END IF;
313 
          EXCEPTION
314 
               WHEN CONSTRAINT_ERROR =>
315 
                    IF NOT CALLED THEN
316 
                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
317 
                                 "-P3 (B1)");
318 
                    END IF;
319 
               WHEN OTHERS =>
320 
                    FAILED ("WRONG EXCEPTION RAISED -P3 (B1)");
321 
          END;
322 
 
323 
          BEGIN
324 
               CALLED := FALSE;
325 
               P3 (FIXED_TYPE (A6), A8);
326 
               IF A6 = 0.0 THEN
327 
                    FAILED ("EXCEPTION NOT RAISED -P3 (B3)");
328 
               ELSE
329 
                    FAILED ("EXCEPTION NOT RAISED -P3 (B4)");
330 
               END IF;
331 
          EXCEPTION
332 
               WHEN CONSTRAINT_ERROR =>
333 
                    IF NOT CALLED THEN
334 
                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
335 
                                 "-P3 (B2)");
336 
                    END IF;
337 
               WHEN OTHERS =>
338 
                    FAILED ("WRONG EXCEPTION RAISED -P3 (B2)");
339 
          END;
340 
 
341 
          BEGIN
342 
               CALLED := FALSE;
343 
               P4 (CHARACTER (A9), A10);
344 
               IF A9 = 'C' THEN
345 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B1)");
346 
               ELSE
347 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B2)");
348 
               END IF;
349 
          EXCEPTION
350 
               WHEN CONSTRAINT_ERROR =>
351 
                    IF NOT CALLED THEN
352 
                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
353 
                                 "-P4 (B1)");
354 
                    END IF;
355 
               WHEN OTHERS =>
356 
                    FAILED ("WRONG EXCEPTION RAISED -P4 (B1)");
357 
          END;
358 
 
359 
          BEGIN
360 
               CALLED := FALSE;
361 
               P4 (CHARACTER (A9), A11);
362 
               IF A9 = 'C' THEN
363 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B3)");
364 
               ELSE
365 
                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B4)");
366 
               END IF;
367 
          EXCEPTION
368 
               WHEN CONSTRAINT_ERROR =>
369 
                    IF NOT CALLED THEN
370 
                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
371 
                                 "-P4 (B2)");
372 
                    END IF;
373 
               WHEN OTHERS =>
374 
                    FAILED ("WRONG EXCEPTION RAISED -P4 (B2)");
375 
          END;
376 
     END;
377 
 
378 
     RESULT;
379 
END C64103B;

powered by: WebSVN 2.1.0

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