Dead
[official-gcc.git] / gomp-20050608-branch / gcc / testsuite / ada / acats / tests / c3 / c32111b.ada
blob85ff55e5d733abeed4d8275258f59f3fc476acab
1 -- C32111B.ADA
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.
16 -- DISCLAIMER
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 WHEN A VARIABLE OR CONSTANT HAVING AN ENUMERATION,
27 -- INTEGER, FLOAT OR FIXED TYPE IS DECLARED WITH AN INITIAL STATIC
28 -- VALUE, CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE LIES
29 -- OUTSIDE THE RANGE OF THE SUBTYPE.
31 -- HISTORY:
32 -- JET 08/04/87 CREATED ORIGINAL TEST BASED ON C32111A BY RJW
33 -- BUT WITH STATIC VALUES INSTEAD OF DYNAMIC
34 -- IDENTITY FUNCTION.
36 WITH REPORT; USE REPORT;
38 PROCEDURE C32111B IS
40 TYPE WEEKDAY IS (MON, TUES, WED, THURS, FRI);
41 SUBTYPE MIDWEEK IS WEEKDAY RANGE WED .. WED;
43 SUBTYPE DIGIT IS CHARACTER RANGE '0' .. '9';
45 SUBTYPE SHORT IS INTEGER RANGE -100 .. 100;
47 TYPE INT IS RANGE -10 .. 10;
48 SUBTYPE PINT IS INT RANGE 1 .. 10;
50 TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
51 SUBTYPE SFLT IS FLT RANGE -5.0 .. 0.0;
53 TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
54 SUBTYPE SFIXED IS FIXED RANGE 0.0 .. 5.0;
56 BEGIN
57 TEST ("C32111B", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
58 "HAVING AN ENUMERATION, INTEGER, FLOAT OR " &
59 "FIXED TYPE IS DECLARED WITH AN INITIAL STATIC " &
60 "VALUE, CONSTRAINT_ERROR IS RAISED IF THE " &
61 "INITIAL VALUE LIES OUTSIDE THE RANGE OF THE " &
62 "SUBTYPE" );
64 BEGIN
65 DECLARE
66 D : MIDWEEK := WEEKDAY'VAL (1);
67 BEGIN
68 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
69 "OF VARIABLE 'D'" );
70 IF D = TUES THEN
71 COMMENT ("VARIABLE 'D' INITIALIZED");
72 END IF;
73 END;
74 EXCEPTION
75 WHEN CONSTRAINT_ERROR =>
76 NULL;
77 WHEN OTHERS =>
78 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
79 "OF VARIABLE 'D'" );
80 END;
82 BEGIN
83 DECLARE
84 D : CONSTANT WEEKDAY RANGE WED .. WED :=
85 WEEKDAY'VAL (3);
86 BEGIN
87 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
88 "OF CONSTANT 'D'" );
89 IF D = TUES THEN
90 COMMENT ("INITIALIZE VARIABLE 'D'");
91 END IF;
92 END;
93 EXCEPTION
94 WHEN CONSTRAINT_ERROR =>
95 NULL;
96 WHEN OTHERS =>
97 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
98 "OF CONSTANT 'D'" );
99 END;
101 BEGIN
102 DECLARE
103 P : CONSTANT DIGIT := '/';
104 BEGIN
105 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
106 "OF CONSTANT 'P'" );
107 IF P = '0' THEN
108 COMMENT ("VARIABLE 'P' INITIALIZED");
109 END IF;
110 END;
111 EXCEPTION
112 WHEN CONSTRAINT_ERROR =>
113 NULL;
114 WHEN OTHERS =>
115 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
116 "OF CONSTANT 'P'" );
117 END;
119 BEGIN
120 DECLARE
121 Q : CHARACTER RANGE 'A' .. 'E' := 'F';
122 BEGIN
123 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
124 "OF VARIABLE 'Q'" );
125 IF Q = 'A' THEN
126 COMMENT ("VARIABLE 'Q' INITIALIZED");
127 END IF;
128 END;
129 EXCEPTION
130 WHEN CONSTRAINT_ERROR =>
131 NULL;
132 WHEN OTHERS =>
133 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
134 "OF VARIABLE 'Q'" );
135 END;
137 BEGIN
138 DECLARE
139 I : SHORT := -101;
140 BEGIN
141 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
142 "OF VARIABLE 'I'" );
143 IF I = 1 THEN
144 COMMENT ("VARIABLE 'I' INITIALIZED");
145 END IF;
146 END;
147 EXCEPTION
148 WHEN CONSTRAINT_ERROR =>
149 NULL;
150 WHEN OTHERS =>
151 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
152 "OF VARIABLE 'I'" );
153 END;
155 BEGIN
156 DECLARE
157 J : CONSTANT INTEGER RANGE 0 .. 100 := 101;
158 BEGIN
159 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
160 "OF CONSTANT 'J'" );
161 IF J = -1 THEN
162 COMMENT ("VARIABLE 'J' INITIALIZED");
163 END IF;
164 END;
165 EXCEPTION
166 WHEN CONSTRAINT_ERROR =>
167 NULL;
168 WHEN OTHERS =>
169 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
170 "OF CONSTANT 'J'" );
171 END;
173 BEGIN
174 DECLARE
175 K : INT RANGE 0 .. 1 := 2;
176 BEGIN
177 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
178 "OF VARIABLE 'K'" );
179 IF K = 2 THEN
180 COMMENT ("VARIABLE 'K' INITIALIZED");
181 END IF;
182 END;
183 EXCEPTION
184 WHEN CONSTRAINT_ERROR =>
185 NULL;
186 WHEN OTHERS =>
187 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
188 "OF VARIABLE 'K'" );
189 END;
191 BEGIN
192 DECLARE
193 L : CONSTANT PINT := 0;
194 BEGIN
195 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
196 "OF CONSTANT 'L'" );
197 IF L = 1 THEN
198 COMMENT ("VARIABLE 'L' INITIALIZED");
199 END IF;
200 END;
201 EXCEPTION
202 WHEN CONSTRAINT_ERROR =>
203 NULL;
204 WHEN OTHERS =>
205 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
206 "OF CONSTANT 'L'" );
207 END;
209 BEGIN
210 DECLARE
211 FL : SFLT := 1.0;
212 BEGIN
213 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
214 "OF VARIABLE 'FL'" );
215 IF FL = 3.14 THEN
216 COMMENT ("VARIABLE 'FL' INITIALIZED");
217 END IF;
218 END;
219 EXCEPTION
220 WHEN CONSTRAINT_ERROR =>
221 NULL;
222 WHEN OTHERS =>
223 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
224 "OF VARIABLE 'FL'" );
225 END;
227 BEGIN
228 DECLARE
229 FL1 : CONSTANT FLT RANGE 0.0 .. 0.0 := -1.0;
230 BEGIN
231 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
232 "OF CONSTANT 'FL1'" );
233 IF FL1 = 0.0 THEN
234 COMMENT ("VARIABLE 'FL1' INITIALIZED");
235 END IF;
236 END;
237 EXCEPTION
238 WHEN CONSTRAINT_ERROR =>
239 NULL;
240 WHEN OTHERS =>
241 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
242 "OF CONSTANT 'FL1'" );
243 END;
245 BEGIN
246 DECLARE
247 FI : FIXED RANGE 0.0 .. 0.0 := 0.5;
248 BEGIN
249 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
250 "OF VARIABLE 'FI'" );
251 IF FI = 0.5 THEN
252 COMMENT ("VARIABLE 'FI' INITIALIZED");
253 END IF;
254 END;
255 EXCEPTION
256 WHEN CONSTRAINT_ERROR =>
257 NULL;
258 WHEN OTHERS =>
259 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
260 "OF VARIABLE 'FI'" );
261 END;
263 BEGIN
264 DECLARE
265 FI1 : CONSTANT SFIXED := -0.5;
266 BEGIN
267 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
268 "OF CONSTANT 'FI1'" );
269 IF FI1 = 0.5 THEN
270 COMMENT ("VARIABLE 'FI1' INITIALIZED");
271 END IF;
272 END;
273 EXCEPTION
274 WHEN CONSTRAINT_ERROR =>
275 NULL;
276 WHEN OTHERS =>
277 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
278 "OF CONSTANT 'FI1'" );
279 END;
281 RESULT;
282 END C32111B;