Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c3/c32115a.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C32115A.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 WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED
27 -- ACCESS TYPE IS DECLARED WITH AN INITIAL NON-NULL ACCESS VALUE,
28 -- CONSTRAINT_ERROR IS RAISED IF AN INDEX BOUND OR A DISCRIMINANT
29 -- VALUE OF THE DESIGNATED OBJECT DOES NOT EQUAL THE CORRESPONDING
30 -- VALUE SPECIFIED FOR THE ACCESS SUBTYPE.
31
32 -- HISTORY:
33 -- RJW 07/20/86 CREATED ORIGINAL TEST.
34 -- JET 08/05/87 ADDED DEFEAT OF DEAD VARIABLE OPTIMIZATION.
35 -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
36
37 WITH REPORT; USE REPORT;
38
39 PROCEDURE C32115A IS
40
41 PACKAGE PKG IS
42 TYPE PRIV (D : INTEGER) IS PRIVATE;
43
44 PRIVATE
45 TYPE PRIV (D : INTEGER) IS
46 RECORD
47 NULL;
48 END RECORD;
49 END PKG;
50
51 USE PKG;
52
53 TYPE ACCP IS ACCESS PRIV (IDENT_INT (1));
54
55 TYPE REC (D : INTEGER) IS
56 RECORD
57 NULL;
58 END RECORD;
59
60 TYPE ACCR IS ACCESS REC (IDENT_INT (2));
61
62 TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
63
64 TYPE ACCA IS ACCESS ARR (IDENT_INT (1) .. IDENT_INT (2));
65
66 TYPE ACCN IS ACCESS ARR (IDENT_INT (1) .. IDENT_INT (0));
67
68 BEGIN
69 TEST ("C32115A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
70 "HAVING A CONSTRAINED ACCESS TYPE IS " &
71 "DECLARED WITH AN INITIAL NON-NULL ACCESS " &
72 "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " &
73 "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " &
74 "DESIGNATED OBJECT DOES NOT EQUAL THE " &
75 "CORRESPONDING VALUE SPECIFIED FOR THE " &
76 "ACCESS SUBTYPE" );
77
78 BEGIN
79 DECLARE
80 AC1 : CONSTANT ACCP := NEW PRIV (D => (IDENT_INT (2)));
81 BEGIN
82 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
83 "OF CONSTANT 'AC1'" );
84 IF AC1 /= NULL THEN
85 COMMENT ("DEFEAT 'AC1' OPTIMIZATION");
86 END IF;
87 END;
88 EXCEPTION
89 WHEN CONSTRAINT_ERROR =>
90 NULL;
91 WHEN OTHERS =>
92 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
93 "OF CONSTANT 'AC1'" );
94 END;
95
96 BEGIN
97 DECLARE
98 AC2 : ACCP := NEW PRIV (D => (IDENT_INT (2)));
99 BEGIN
100 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
101 "OF VARIABLE 'AC2'" );
102 IF AC2 /= NULL THEN
103 COMMENT ("DEFEAT 'AC2' OPTIMIZATION");
104 END IF;
105 END;
106 EXCEPTION
107 WHEN CONSTRAINT_ERROR =>
108 NULL;
109 WHEN OTHERS =>
110 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
111 "OF VARIABLE 'AC2'" );
112 END;
113
114 BEGIN
115 DECLARE
116 AC3 : CONSTANT ACCP := NEW PRIV (D => (IDENT_INT (0)));
117 BEGIN
118 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
119 "OF CONSTANT 'AC3'" );
120 IF AC3 /= NULL THEN
121 COMMENT ("DEFEAT 'AC3' OPTIMIZATION");
122 END IF;
123 END;
124 EXCEPTION
125 WHEN CONSTRAINT_ERROR =>
126 NULL;
127 WHEN OTHERS =>
128 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
129 "OF CONSTANT 'AC3'" );
130 END;
131
132 BEGIN
133 DECLARE
134 AC4 : ACCP := NEW PRIV (D => (IDENT_INT (0)));
135 BEGIN
136 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
137 "OF VARIABLE 'AC4'" );
138 IF AC4 /= NULL THEN
139 COMMENT ("DEFEAT 'AC4' OPTIMIZATION");
140 END IF;
141 END;
142 EXCEPTION
143 WHEN CONSTRAINT_ERROR =>
144 NULL;
145 WHEN OTHERS =>
146 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
147 "OF VARIABLE 'AC4'" );
148 END;
149
150 BEGIN
151 DECLARE
152 AC5 : CONSTANT ACCR := NEW REC'(D => (IDENT_INT (1)));
153 BEGIN
154 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
155 "OF CONSTANT 'AC5'" );
156 IF AC5 /= NULL THEN
157 COMMENT ("DEFEAT 'AC5' OPTIMIZATION");
158 END IF;
159 END;
160 EXCEPTION
161 WHEN CONSTRAINT_ERROR =>
162 NULL;
163 WHEN OTHERS =>
164 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
165 "OF CONSTANT 'AC5'" );
166 END;
167
168 BEGIN
169 DECLARE
170 AC6 : ACCR := NEW REC' (D => (IDENT_INT (1)));
171 BEGIN
172 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
173 "OF VARIABLE 'AC6'" );
174 IF AC6 /= NULL THEN
175 COMMENT ("DEFEAT 'AC6' OPTIMIZATION");
176 END IF;
177 END;
178 EXCEPTION
179 WHEN CONSTRAINT_ERROR =>
180 NULL;
181 WHEN OTHERS =>
182 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
183 "OF VARIABLE 'AC6'" );
184 END;
185
186 BEGIN
187 DECLARE
188 AC7 : CONSTANT ACCR := NEW REC'(D => (IDENT_INT (3)));
189 BEGIN
190 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
191 "OF CONSTANT 'AC7'" );
192 IF AC7 /= NULL THEN
193 COMMENT ("DEFEAT 'AC7' OPTIMIZATION");
194 END IF;
195 END;
196 EXCEPTION
197 WHEN CONSTRAINT_ERROR =>
198 NULL;
199 WHEN OTHERS =>
200 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
201 "OF CONSTANT 'AC7'" );
202 END;
203
204 BEGIN
205 DECLARE
206 AC8 : ACCR := NEW REC' (D => (IDENT_INT (3)));
207 BEGIN
208 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
209 "OF VARIABLE 'AC8'" );
210 IF AC8 /= NULL THEN
211 COMMENT ("DEFEAT 'AC8' OPTIMIZATION");
212 END IF;
213 END;
214 EXCEPTION
215 WHEN CONSTRAINT_ERROR =>
216 NULL;
217 WHEN OTHERS =>
218 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
219 "OF VARIABLE 'AC8'" );
220 END;
221
222 BEGIN
223 DECLARE
224 AC9 : CONSTANT ACCA :=
225 NEW ARR'(IDENT_INT (1) .. IDENT_INT (1) => 0);
226 BEGIN
227 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
228 "OF CONSTANT 'AC9'" );
229 IF AC9 /= NULL THEN
230 COMMENT ("DEFEAT 'AC9' OPTIMIZATION");
231 END IF;
232 END;
233 EXCEPTION
234 WHEN CONSTRAINT_ERROR =>
235 NULL;
236 WHEN OTHERS =>
237 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
238 "OF CONSTANT 'AC9'" );
239 END;
240
241 BEGIN
242 DECLARE
243 AC10 : ACCA :=
244 NEW ARR'(IDENT_INT (1) .. IDENT_INT (1) => 0);
245 BEGIN
246 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
247 "OF VARIABLE 'AC10'" );
248 IF AC10 /= NULL THEN
249 COMMENT ("DEFEAT 'AC10' OPTIMIZATION");
250 END IF;
251 END;
252 EXCEPTION
253 WHEN CONSTRAINT_ERROR =>
254 NULL;
255 WHEN OTHERS =>
256 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
257 "OF VARIABLE 'AC10'" );
258 END;
259
260 BEGIN
261 DECLARE
262 AC11 : CONSTANT ACCA :=
263 NEW ARR' (IDENT_INT (0) .. IDENT_INT (2) => 0);
264 BEGIN
265 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
266 "OF CONSTANT 'AC11'" );
267 IF AC11 /= NULL THEN
268 COMMENT ("DEFEAT 'AC11' OPTIMIZATION");
269 END IF;
270 END;
271 EXCEPTION
272 WHEN CONSTRAINT_ERROR =>
273 NULL;
274 WHEN OTHERS =>
275 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
276 "OF CONSTANT 'AC11'" );
277 END;
278
279 BEGIN
280 DECLARE
281 AC12 : ACCA :=
282 NEW ARR'(IDENT_INT (0) .. IDENT_INT (2) => 0);
283 BEGIN
284 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
285 "OF VARIABLE 'AC12'" );
286 IF AC12 /= NULL THEN
287 COMMENT ("DEFEAT 'AC12' OPTIMIZATION");
288 END IF;
289 END;
290 EXCEPTION
291 WHEN CONSTRAINT_ERROR =>
292 NULL;
293 WHEN OTHERS =>
294 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
295 "OF VARIABLE 'AC12'" );
296 END;
297
298
299 BEGIN
300 DECLARE
301 AC15 : CONSTANT ACCN :=
302 NEW ARR' (IDENT_INT (0) .. IDENT_INT (0) => 0);
303 BEGIN
304 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
305 "OF CONSTANT 'AC15'" );
306 IF AC15 /= NULL THEN
307 COMMENT ("DEFEAT 'AC15' OPTIMIZATION");
308 END IF;
309 END;
310 EXCEPTION
311 WHEN CONSTRAINT_ERROR =>
312 NULL;
313 WHEN OTHERS =>
314 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
315 "OF CONSTANT 'AC15'" );
316 END;
317
318 BEGIN
319 DECLARE
320 AC16 : ACCN :=
321 NEW ARR'(IDENT_INT (0) .. IDENT_INT (0) => 0);
322 BEGIN
323 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
324 "OF VARIABLE 'AC16'" );
325 IF AC16 /= NULL THEN
326 COMMENT ("DEFEAT 'AC16' OPTIMIZATION");
327 END IF;
328 END;
329 EXCEPTION
330 WHEN CONSTRAINT_ERROR =>
331 NULL;
332 WHEN OTHERS =>
333 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
334 "OF VARIABLE 'AC16'" );
335 END;
336
337 RESULT;
338 END C32115A;