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 294

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.