annotate gcc/testsuite/ada/acats/tests/c3/c32111a.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- C32111A.ADA
kono
parents:
diff changeset
2
kono
parents:
diff changeset
3 -- Grant of Unlimited Rights
kono
parents:
diff changeset
4 --
kono
parents:
diff changeset
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
kono
parents:
diff changeset
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
kono
parents:
diff changeset
7 -- unlimited rights in the software and documentation contained herein.
kono
parents:
diff changeset
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
kono
parents:
diff changeset
9 -- this public release, the Government intends to confer upon all
kono
parents:
diff changeset
10 -- recipients unlimited rights equal to those held by the Government.
kono
parents:
diff changeset
11 -- These rights include rights to use, duplicate, release or disclose the
kono
parents:
diff changeset
12 -- released technical data and computer software in whole or in part, in
kono
parents:
diff changeset
13 -- any manner and for any purpose whatsoever, and to have or permit others
kono
parents:
diff changeset
14 -- to do so.
kono
parents:
diff changeset
15 --
kono
parents:
diff changeset
16 -- DISCLAIMER
kono
parents:
diff changeset
17 --
kono
parents:
diff changeset
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
kono
parents:
diff changeset
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
kono
parents:
diff changeset
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
kono
parents:
diff changeset
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
kono
parents:
diff changeset
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
kono
parents:
diff changeset
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
kono
parents:
diff changeset
24 --*
kono
parents:
diff changeset
25 -- OBJECTIVE:
kono
parents:
diff changeset
26 -- CHECK THAT WHEN A VARIABLE OR CONSTANT HAVING AN ENUMERATION,
kono
parents:
diff changeset
27 -- INTEGER, FLOAT OR FIXED TYPE IS DECLARED WITH AN INITIAL VALUE,
kono
parents:
diff changeset
28 -- CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE LIES OUTSIDE THE
kono
parents:
diff changeset
29 -- RANGE OF THE SUBTYPE.
kono
parents:
diff changeset
30
kono
parents:
diff changeset
31 -- HISTORY:
kono
parents:
diff changeset
32 -- RJW 07/20/86 CREATED ORIGINAL TEST.
kono
parents:
diff changeset
33 -- JET 08/04/87 IMPROVED DEFEAT OF COMPILER OPTIMIZATION.
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 WITH REPORT; USE REPORT;
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 PROCEDURE C32111A IS
kono
parents:
diff changeset
38
kono
parents:
diff changeset
39 TYPE WEEKDAY IS (MON, TUES, WED, THURS, FRI);
kono
parents:
diff changeset
40 SUBTYPE MIDWEEK IS WEEKDAY RANGE WED .. WED;
kono
parents:
diff changeset
41
kono
parents:
diff changeset
42 SUBTYPE DIGIT IS CHARACTER RANGE '0' .. '9';
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 SUBTYPE SHORT IS INTEGER RANGE -100 .. 100;
kono
parents:
diff changeset
45
kono
parents:
diff changeset
46 TYPE INT IS RANGE -10 .. 10;
kono
parents:
diff changeset
47 SUBTYPE PINT IS INT RANGE 1 .. 10;
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
kono
parents:
diff changeset
50 SUBTYPE SFLT IS FLT RANGE -5.0 .. 0.0;
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
kono
parents:
diff changeset
53 SUBTYPE SFIXED IS FIXED RANGE 0.0 .. 5.0;
kono
parents:
diff changeset
54
kono
parents:
diff changeset
55 BEGIN
kono
parents:
diff changeset
56 TEST ("C32111A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
kono
parents:
diff changeset
57 "HAVING AN ENUMERATION, INTEGER, FLOAT OR " &
kono
parents:
diff changeset
58 "FIXED TYPE IS DECLARED WITH AN INITIAL " &
kono
parents:
diff changeset
59 "VALUE, CONSTRAINT_ERROR IS RAISED IF THE " &
kono
parents:
diff changeset
60 "INITIAL VALUE LIES OUTSIDE THE RANGE OF THE " &
kono
parents:
diff changeset
61 "SUBTYPE" );
kono
parents:
diff changeset
62
kono
parents:
diff changeset
63 BEGIN
kono
parents:
diff changeset
64 DECLARE
kono
parents:
diff changeset
65 D : MIDWEEK := WEEKDAY'VAL (IDENT_INT (1));
kono
parents:
diff changeset
66 BEGIN
kono
parents:
diff changeset
67 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
68 "OF VARIABLE 'D'" );
kono
parents:
diff changeset
69 IF D = TUES THEN
kono
parents:
diff changeset
70 COMMENT ("VARIABLE 'D' INITIALIZED");
kono
parents:
diff changeset
71 END IF;
kono
parents:
diff changeset
72 END;
kono
parents:
diff changeset
73 EXCEPTION
kono
parents:
diff changeset
74 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
75 NULL;
kono
parents:
diff changeset
76 WHEN OTHERS =>
kono
parents:
diff changeset
77 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
78 "OF VARIABLE 'D'" );
kono
parents:
diff changeset
79 END;
kono
parents:
diff changeset
80
kono
parents:
diff changeset
81 BEGIN
kono
parents:
diff changeset
82 DECLARE
kono
parents:
diff changeset
83 D : CONSTANT WEEKDAY RANGE WED .. WED :=
kono
parents:
diff changeset
84 WEEKDAY'VAL (IDENT_INT (3));
kono
parents:
diff changeset
85 BEGIN
kono
parents:
diff changeset
86 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
87 "OF CONSTANT 'D'" );
kono
parents:
diff changeset
88 IF D = TUES THEN
kono
parents:
diff changeset
89 COMMENT ("INITIALIZE VARIABLE 'D'");
kono
parents:
diff changeset
90 END IF;
kono
parents:
diff changeset
91 END;
kono
parents:
diff changeset
92 EXCEPTION
kono
parents:
diff changeset
93 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
94 NULL;
kono
parents:
diff changeset
95 WHEN OTHERS =>
kono
parents:
diff changeset
96 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
97 "OF CONSTANT 'D'" );
kono
parents:
diff changeset
98 END;
kono
parents:
diff changeset
99
kono
parents:
diff changeset
100 BEGIN
kono
parents:
diff changeset
101 DECLARE
kono
parents:
diff changeset
102 P : CONSTANT DIGIT := IDENT_CHAR ('/');
kono
parents:
diff changeset
103 BEGIN
kono
parents:
diff changeset
104 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
105 "OF CONSTANT 'P'" );
kono
parents:
diff changeset
106 IF P = '0' THEN
kono
parents:
diff changeset
107 COMMENT ("VARIABLE 'P' INITIALIZED");
kono
parents:
diff changeset
108 END IF;
kono
parents:
diff changeset
109 END;
kono
parents:
diff changeset
110 EXCEPTION
kono
parents:
diff changeset
111 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
112 NULL;
kono
parents:
diff changeset
113 WHEN OTHERS =>
kono
parents:
diff changeset
114 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
115 "OF CONSTANT 'P'" );
kono
parents:
diff changeset
116 END;
kono
parents:
diff changeset
117
kono
parents:
diff changeset
118 BEGIN
kono
parents:
diff changeset
119 DECLARE
kono
parents:
diff changeset
120 Q : CHARACTER RANGE 'A' .. 'E' := IDENT_CHAR ('F');
kono
parents:
diff changeset
121 BEGIN
kono
parents:
diff changeset
122 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
123 "OF VARIABLE 'Q'" );
kono
parents:
diff changeset
124 IF Q = 'A' THEN
kono
parents:
diff changeset
125 COMMENT ("VARIABLE 'Q' INITIALIZED");
kono
parents:
diff changeset
126 END IF;
kono
parents:
diff changeset
127 END;
kono
parents:
diff changeset
128 EXCEPTION
kono
parents:
diff changeset
129 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
130 NULL;
kono
parents:
diff changeset
131 WHEN OTHERS =>
kono
parents:
diff changeset
132 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
133 "OF VARIABLE 'Q'" );
kono
parents:
diff changeset
134 END;
kono
parents:
diff changeset
135
kono
parents:
diff changeset
136 BEGIN
kono
parents:
diff changeset
137 DECLARE
kono
parents:
diff changeset
138 I : SHORT := IDENT_INT (-101);
kono
parents:
diff changeset
139 BEGIN
kono
parents:
diff changeset
140 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
141 "OF VARIABLE 'I'" );
kono
parents:
diff changeset
142 IF I = 1 THEN
kono
parents:
diff changeset
143 COMMENT ("VARIABLE 'I' INITIALIZED");
kono
parents:
diff changeset
144 END IF;
kono
parents:
diff changeset
145 END;
kono
parents:
diff changeset
146 EXCEPTION
kono
parents:
diff changeset
147 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
148 NULL;
kono
parents:
diff changeset
149 WHEN OTHERS =>
kono
parents:
diff changeset
150 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
151 "OF VARIABLE 'I'" );
kono
parents:
diff changeset
152 END;
kono
parents:
diff changeset
153
kono
parents:
diff changeset
154 BEGIN
kono
parents:
diff changeset
155 DECLARE
kono
parents:
diff changeset
156 J : CONSTANT INTEGER RANGE 0 .. 100 := IDENT_INT (101);
kono
parents:
diff changeset
157 BEGIN
kono
parents:
diff changeset
158 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
159 "OF CONSTANT 'J'" );
kono
parents:
diff changeset
160 IF J = -1 THEN
kono
parents:
diff changeset
161 COMMENT ("VARIABLE 'J' INITIALIZED");
kono
parents:
diff changeset
162 END IF;
kono
parents:
diff changeset
163 END;
kono
parents:
diff changeset
164 EXCEPTION
kono
parents:
diff changeset
165 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
166 NULL;
kono
parents:
diff changeset
167 WHEN OTHERS =>
kono
parents:
diff changeset
168 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
169 "OF CONSTANT 'J'" );
kono
parents:
diff changeset
170 END;
kono
parents:
diff changeset
171
kono
parents:
diff changeset
172 BEGIN
kono
parents:
diff changeset
173 DECLARE
kono
parents:
diff changeset
174 K : INT RANGE 0 .. 1 := INT (IDENT_INT (2));
kono
parents:
diff changeset
175 BEGIN
kono
parents:
diff changeset
176 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
177 "OF VARIABLE 'K'" );
kono
parents:
diff changeset
178 IF K = 2 THEN
kono
parents:
diff changeset
179 COMMENT ("VARIABLE 'K' INITIALIZED");
kono
parents:
diff changeset
180 END IF;
kono
parents:
diff changeset
181 END;
kono
parents:
diff changeset
182 EXCEPTION
kono
parents:
diff changeset
183 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
184 NULL;
kono
parents:
diff changeset
185 WHEN OTHERS =>
kono
parents:
diff changeset
186 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
187 "OF VARIABLE 'K'" );
kono
parents:
diff changeset
188 END;
kono
parents:
diff changeset
189
kono
parents:
diff changeset
190 BEGIN
kono
parents:
diff changeset
191 DECLARE
kono
parents:
diff changeset
192 L : CONSTANT PINT := INT (IDENT_INT (0));
kono
parents:
diff changeset
193 BEGIN
kono
parents:
diff changeset
194 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
195 "OF CONSTANT 'L'" );
kono
parents:
diff changeset
196 IF L = 1 THEN
kono
parents:
diff changeset
197 COMMENT ("VARIABLE 'L' INITIALIZED");
kono
parents:
diff changeset
198 END IF;
kono
parents:
diff changeset
199 END;
kono
parents:
diff changeset
200 EXCEPTION
kono
parents:
diff changeset
201 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
202 NULL;
kono
parents:
diff changeset
203 WHEN OTHERS =>
kono
parents:
diff changeset
204 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
205 "OF CONSTANT 'L'" );
kono
parents:
diff changeset
206 END;
kono
parents:
diff changeset
207
kono
parents:
diff changeset
208 BEGIN
kono
parents:
diff changeset
209 DECLARE
kono
parents:
diff changeset
210 FL : SFLT := FLT (IDENT_INT (1));
kono
parents:
diff changeset
211 BEGIN
kono
parents:
diff changeset
212 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
213 "OF VARIABLE 'FL'" );
kono
parents:
diff changeset
214 IF FL = 3.14 THEN
kono
parents:
diff changeset
215 COMMENT ("VARIABLE 'FL' INITIALIZED");
kono
parents:
diff changeset
216 END IF;
kono
parents:
diff changeset
217 END;
kono
parents:
diff changeset
218 EXCEPTION
kono
parents:
diff changeset
219 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
220 NULL;
kono
parents:
diff changeset
221 WHEN OTHERS =>
kono
parents:
diff changeset
222 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
223 "OF VARIABLE 'FL'" );
kono
parents:
diff changeset
224 END;
kono
parents:
diff changeset
225
kono
parents:
diff changeset
226 BEGIN
kono
parents:
diff changeset
227 DECLARE
kono
parents:
diff changeset
228 FL1 : CONSTANT FLT RANGE 0.0 .. 0.0 :=
kono
parents:
diff changeset
229 FLT (IDENT_INT (-1));
kono
parents:
diff changeset
230 BEGIN
kono
parents:
diff changeset
231 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
232 "OF CONSTANT 'FL1'" );
kono
parents:
diff changeset
233 IF FL1 = 0.0 THEN
kono
parents:
diff changeset
234 COMMENT ("VARIABLE 'FL1' INITIALIZED");
kono
parents:
diff changeset
235 END IF;
kono
parents:
diff changeset
236 END;
kono
parents:
diff changeset
237 EXCEPTION
kono
parents:
diff changeset
238 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
239 NULL;
kono
parents:
diff changeset
240 WHEN OTHERS =>
kono
parents:
diff changeset
241 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
242 "OF CONSTANT 'FL1'" );
kono
parents:
diff changeset
243 END;
kono
parents:
diff changeset
244
kono
parents:
diff changeset
245 BEGIN
kono
parents:
diff changeset
246 DECLARE
kono
parents:
diff changeset
247 FI : FIXED RANGE 0.0 .. 0.0 := IDENT_INT (1) * 0.5;
kono
parents:
diff changeset
248 BEGIN
kono
parents:
diff changeset
249 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
250 "OF VARIABLE 'FI'" );
kono
parents:
diff changeset
251 IF FI = 0.5 THEN
kono
parents:
diff changeset
252 COMMENT ("VARIABLE 'FI' INITIALIZED");
kono
parents:
diff changeset
253 END IF;
kono
parents:
diff changeset
254 END;
kono
parents:
diff changeset
255 EXCEPTION
kono
parents:
diff changeset
256 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
257 NULL;
kono
parents:
diff changeset
258 WHEN OTHERS =>
kono
parents:
diff changeset
259 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
260 "OF VARIABLE 'FI'" );
kono
parents:
diff changeset
261 END;
kono
parents:
diff changeset
262
kono
parents:
diff changeset
263 BEGIN
kono
parents:
diff changeset
264 DECLARE
kono
parents:
diff changeset
265 FI1 : CONSTANT SFIXED := IDENT_INT (-1) * 0.5;
kono
parents:
diff changeset
266 BEGIN
kono
parents:
diff changeset
267 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
268 "OF CONSTANT 'FI1'" );
kono
parents:
diff changeset
269 IF FI1 = 0.5 THEN
kono
parents:
diff changeset
270 COMMENT ("VARIABLE 'FI1' INITIALIZED");
kono
parents:
diff changeset
271 END IF;
kono
parents:
diff changeset
272 END;
kono
parents:
diff changeset
273 EXCEPTION
kono
parents:
diff changeset
274 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
275 NULL;
kono
parents:
diff changeset
276 WHEN OTHERS =>
kono
parents:
diff changeset
277 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
kono
parents:
diff changeset
278 "OF CONSTANT 'FI1'" );
kono
parents:
diff changeset
279 END;
kono
parents:
diff changeset
280
kono
parents:
diff changeset
281 RESULT;
kono
parents:
diff changeset
282 END C32111A;