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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

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