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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c46014a.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C46014A.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
--     FOR PREDEFINED TYPE INTEGER, CHECK THAT
27
--     CONSTRAINT_ERROR IS RAISED IF THE OPERAND VALUE OF A
28
--     CONVERSION LIES OUTSIDE OF THE RANGE OF THE TARGET TYPE'S BASE
29
--     TYPE. ALSO, CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE
30
--     OPERAND VALUE LIES OUTSIDE OF THE RANGE OF THE TARGET TYPE'S
31
--     SUBTYPE BUT WITHIN THE RANGE OF THE BASE TYPE.
32
 
33
-- HISTORY:
34
--     RJW 09/08/86  CREATED ORIGINAL TEST.
35
--     RJW 11/13/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
36
--     JET 12/30/87  ADDED MORE CODE TO PREVENT OPTIMIZATION.
37
--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
38
--     JRL 12/08/96  Changed usages of System.Max_Int and System.Min_Int to
39
--                   Integer'Base'Last and Integer'Base'First in first two
40
--                   subtests.
41
 
42
WITH REPORT; USE REPORT;
43
PROCEDURE C46014A IS
44
 
45
     SUBTYPE SMALL IS INTEGER RANGE -100 .. 100;
46
     S1 : SMALL;
47
 
48
     TYPE INT IS RANGE -100 .. 100;
49
     T1 : INT;
50
 
51
     TYPE NEWINTEGER IS NEW INTEGER;
52
     N1 : NEWINTEGER;
53
 
54
     SUBTYPE SUBNEW IS NEWINTEGER RANGE -100 .. 100;
55
     SN : SUBNEW;
56
 
57
     I1 : INTEGER;
58
     P1 : POSITIVE;
59
     L1 : NATURAL;
60
 
61
     FUNCTION IDENT (I : INTEGER) RETURN INT IS
62
     BEGIN
63
          RETURN INT'VAL (IDENT_INT (I));
64
     END IDENT;
65
 
66
     FUNCTION IDENT (I : NEWINTEGER) RETURN NEWINTEGER IS
67
     BEGIN
68
          RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (I)));
69
     END IDENT;
70
 
71
BEGIN
72
     TEST ( "C46014A", "FOR PREDEFINED TYPE INTEGER, CHECK THAT " &
73
                       "CONSTRAINT_ERROR IS RAISED IF " &
74
                       "THE OPERAND VALUE OF A CONVERSION LIES " &
75
                       "OUTSIDE OF THE RANGE OF THE TARGET TYPE'S " &
76
                       "BASE TYPE. ALSO, CHECK THAT " &
77
                       "CONSTRAINT_ERROR IS RAISED IF THE OPERAND " &
78
                       "VALUE LIES OUTSIDE OF THE RANGE OF THE " &
79
                       "TARGET TYPE'S SUBTYPE BUT WITHIN THE " &
80
                       "RANGE OF THE BASE TYPE" );
81
 
82
     BEGIN
83
          I1 := Integer'Base'Last + Ident_Int(1);
84
          Failed ("NO EXCEPTION RAISED FOR INTEGER'BASE'LAST + 1");
85
          IF EQUAL (I1, I1) THEN
86
               COMMENT ("SHOULDN'T GET HERE");
87
          END IF;
88
     EXCEPTION
89
          WHEN CONSTRAINT_ERROR =>
90
               Comment ("CONSTRAINT_ERROR RAISED FOR INTEGER'BASE'LAST + 1");
91
          WHEN OTHERS =>
92
               Failed ("WRONG EXCEPTION RAISED FOR INTEGER'BASE'LAST + 1");
93
     END;
94
 
95
     BEGIN
96
          I1 := Integer'Base'First - Ident_Int(1);
97
          Failed ("NO EXCEPTION RAISED FOR INTEGER'BASE'FIRST - 1");
98
          IF EQUAL (I1, I1) THEN
99
               COMMENT ("SHOULDN'T GET HERE");
100
          END IF;
101
     EXCEPTION
102
          WHEN CONSTRAINT_ERROR =>
103
               Comment ("CONSTRAINT_ERROR RAISED FOR INTEGER'BASE'FIRST - 1");
104
          WHEN OTHERS =>
105
               Failed ("WRONG EXCEPTION RAISED FOR INTEGER'BASE'FIRST - 1");
106
     END;
107
 
108
     BEGIN
109
          I1 := INTEGER (IDENT_INT (INTEGER'FIRST) - 1);
110
          FAILED ( "NO EXCEPTION RAISED FOR " &
111
                   "INTEGER (IDENT_INT (INTEGER'FIRST) - 1)" );
112
          IF EQUAL (I1, I1) THEN
113
               COMMENT ("SHOULDN'T GET HERE");
114
          END IF;
115
     EXCEPTION
116
          WHEN CONSTRAINT_ERROR =>
117
               COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
118
                         "INTEGER (IDENT_INT (INTEGER'FIRST - 1)" );
119
          WHEN OTHERS =>
120
               FAILED ( "WRONG EXCEPTION RAISED FOR " &
121
                        "INTEGER (IDENT_INT (INTEGER'FIRST - 1)" );
122
     END;
123
 
124
     BEGIN
125
          N1 := NEWINTEGER (IDENT_INT (INTEGER'LAST) + 1);
126
          FAILED ( "NO EXCEPTION RAISED FOR " &
127
                   "NEWINTEGER (IDENT_INT (INTEGER'LAST) + 1)" );
128
          IF EQUAL (INTEGER (N1), INTEGER (N1)) THEN
129
               COMMENT ("SHOULDN'T GET HERE");
130
          END IF;
131
     EXCEPTION
132
          WHEN CONSTRAINT_ERROR =>
133
               COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
134
                         "NEWINTEGER (IDENT_INT (INTEGER'LAST + 1)" );
135
          WHEN OTHERS =>
136
               FAILED ( "WRONG EXCEPTION RAISED FOR " &
137
                        "NEWINTEGER (IDENT_INT (INTEGER'LAST + 1)" );
138
     END;
139
 
140
     BEGIN
141
          T1 := INT (INT'BASE'FIRST - IDENT (1));
142
          FAILED ( "NO EXCEPTION RAISED FOR " &
143
                   "INT (INT'BASE'FIRST - IDENT (1))" );
144
          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
145
               COMMENT ("SHOULDN'T GET HERE");
146
          END IF;
147
     EXCEPTION
148
          WHEN CONSTRAINT_ERROR =>
149
               COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
150
                         "INT (INT'BASE'FIRST - IDENT (1))" );
151
          WHEN OTHERS =>
152
               FAILED ( "WRONG EXCEPTION RAISED FOR " &
153
                        "INT (INT'BASE'FIRST - IDENT (1))" );
154
     END;
155
 
156
     BEGIN
157
          T1 := IDENT (-101);
158
          FAILED ( "NO EXCEPTION RAISED FOR " &
159
                   "T1 := -101" );
160
          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
161
               COMMENT ("SHOULDN'T GET HERE");
162
          END IF;
163
     EXCEPTION
164
          WHEN CONSTRAINT_ERROR =>
165
               NULL;
166
          WHEN OTHERS =>
167
               FAILED ( "WRONG EXCEPTION RAISED FOR " &
168
                        "T1 := -101" );
169
     END;
170
 
171
     BEGIN
172
          T1 := INTEGER'POS (IDENT_INT (101));
173
          FAILED ( "NO EXCEPTION RAISED FOR " &
174
                   "T1 := INTEGER'POS (IDENT_INT (101))" );
175
          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
176
               COMMENT ("SHOULDN'T GET HERE");
177
          END IF;
178
     EXCEPTION
179
          WHEN CONSTRAINT_ERROR =>
180
               NULL;
181
          WHEN OTHERS =>
182
               FAILED ( "WRONG EXCEPTION RAISED FOR " &
183
                        "T1 := INTEGER'POS (IDENT_INT (101));" );
184
     END;
185
 
186
     BEGIN
187
          T1 := INT (IDENT (INTEGER (INT'FIRST)) - 1);
188
          FAILED ( "NO EXCEPTION RAISED FOR " &
189
                   "INT (INT'FIRST - 1)" );
190
          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
191
               COMMENT ("SHOULDN'T GET HERE");
192
          END IF;
193
     EXCEPTION
194
          WHEN CONSTRAINT_ERROR =>
195
               NULL;
196
          WHEN OTHERS =>
197
               FAILED ( "WRONG EXCEPTION RAISED FOR " &
198
                        "INT (INT'FIRST - 1)" );
199
     END;
200
 
201
     BEGIN
202
          T1 := INT (IDENT_INT (101));
203
          FAILED ( "NO EXCEPTION RAISED FOR INT (101)" );
204
          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
205
               COMMENT ("SHOULDN'T GET HERE");
206
          END IF;
207
     EXCEPTION
208
          WHEN CONSTRAINT_ERROR =>
209
               NULL;
210
          WHEN OTHERS =>
211
               FAILED ( "WRONG EXCEPTION RAISED FOR INT (101)" );
212
     END;
213
 
214
     BEGIN
215
          S1 := SMALL (IDENT_INT (101));
216
          FAILED ( "NO EXCEPTION RAISED FOR SMALL (101)" );
217
          IF EQUAL (S1, S1) THEN
218
               COMMENT ("SHOULDN'T GET HERE");
219
          END IF;
220
     EXCEPTION
221
          WHEN CONSTRAINT_ERROR =>
222
               NULL;
223
          WHEN OTHERS =>
224
               FAILED ( "WRONG EXCEPTION RAISED FOR SMALL (101)" );
225
     END;
226
 
227
     BEGIN
228
          SN := SUBNEW (IDENT_INT (-101));
229
          FAILED ( "NO EXCEPTION RAISED FOR SUBNEW (-101)" );
230
          IF EQUAL (INTEGER (SN), INTEGER (SN)) THEN
231
               COMMENT ("SHOULDN'T GET HERE");
232
          END IF;
233
     EXCEPTION
234
          WHEN CONSTRAINT_ERROR =>
235
               NULL;
236
          WHEN OTHERS =>
237
               FAILED ( "WRONG EXCEPTION RAISED FOR SUBNEW (-101)" );
238
     END;
239
 
240
     BEGIN
241
          P1 := IDENT_INT (101);
242
          SN := SUBNEW (P1);
243
          FAILED ( "NO EXCEPTION RAISED FOR SUBNEW (P1)" );
244
          IF EQUAL (INTEGER (SN), INTEGER (SN)) THEN
245
               COMMENT ("SHOULDN'T GET HERE");
246
          END IF;
247
     EXCEPTION
248
          WHEN CONSTRAINT_ERROR =>
249
               NULL;
250
          WHEN OTHERS =>
251
               FAILED ( "WRONG EXCEPTION RAISED FOR SUBNEW (P1)" );
252
     END;
253
 
254
     BEGIN
255
          SN := IDENT (0);
256
          P1 := POSITIVE (SN);
257
          FAILED ( "NO EXCEPTION RAISED FOR " &
258
                   "POSITIVE (SN)" );
259
          IF EQUAL (P1, P1) THEN
260
               COMMENT ("SHOULDN'T GET HERE");
261
          END IF;
262
     EXCEPTION
263
          WHEN CONSTRAINT_ERROR =>
264
               NULL;
265
          WHEN OTHERS =>
266
               FAILED ( "WRONG EXCEPTION RAISED FOR " &
267
                        "POSITIVE (SN)" );
268
     END;
269
 
270
     BEGIN
271
          N1 := IDENT (-1);
272
          L1 := NATURAL (N1);
273
          FAILED ( "NO EXCEPTION RAISED FOR " &
274
                   "NATURAL (N1)" );
275
          IF EQUAL (L1, L1) THEN
276
               COMMENT ("SHOULDN'T GET HERE");
277
          END IF;
278
     EXCEPTION
279
          WHEN CONSTRAINT_ERROR =>
280
               NULL;
281
          WHEN OTHERS =>
282
               FAILED ( "WRONG EXCEPTION RAISED FOR " &
283
                        "NATURAL (N1)" );
284
     END;
285
 
286
     RESULT;
287
END C46014A;

powered by: WebSVN 2.1.0

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