Remove old autovect-branch by moving to "dead" directory.
[official-gcc.git] / old-autovect-branch / gcc / testsuite / ada / acats / tests / c3 / c32115b.ada
blobd1819c569a9b5a5cf2dd0004e9bbac8de6673113
1 -- C32115B.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 UNCONSTRAINED
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 OF THE OBJECT.
32 -- HISTORY:
33 -- JET 08/05/87 CREATED ORIGINAL TEST BASED ON C32115A BY RJW
34 -- BUT WITH UNCONSTRAINED ACCESS TYPES AND
35 -- CONSTRAINED VARIABLE/CONSTANT DECLARATIONS.
36 -- KAS 12/4/95 FIXED TYPO IN CALL TO REPORT.TEST
38 WITH REPORT; USE REPORT;
40 PROCEDURE C32115B IS
42 PACKAGE PKG IS
43 TYPE PRIV (D : INTEGER) IS PRIVATE;
45 PRIVATE
46 TYPE PRIV (D : INTEGER) IS
47 RECORD
48 NULL;
49 END RECORD;
50 END PKG;
52 USE PKG;
54 TYPE ACCP IS ACCESS PRIV;
56 TYPE REC (D : INTEGER) IS
57 RECORD
58 NULL;
59 END RECORD;
61 TYPE ACCR IS ACCESS REC;
63 TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
65 TYPE ACCA IS ACCESS ARR;
67 TYPE ACCN IS ACCESS ARR;
69 BEGIN
70 TEST ("C32115B", "CHECK THAT WHEN CONSTRAINED VARIABLE OR " &
71 "CONSTANT HAVING AN UNCONSTRAINED ACCESS TYPE " &
72 "IS DECLARED WITH AN INITIAL NON-NULL ACCESS " &
73 "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " &
74 "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " &
75 "DESIGNATED OBJECT DOES NOT EQUAL THE " &
76 "CORRESPONDING VALUE SPECIFIED FOR THE " &
77 "ACCESS SUBTYPE OF THE OBJECT" );
79 BEGIN
80 DECLARE
81 AC1 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (2));
82 BEGIN
83 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
84 "OF CONSTANT 'AC1'" );
85 IF AC1 /= NULL THEN
86 COMMENT ("DEFEAT 'AC1' OPTIMIZATION");
87 END IF;
88 END;
89 EXCEPTION
90 WHEN CONSTRAINT_ERROR =>
91 NULL;
92 WHEN OTHERS =>
93 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
94 "OF CONSTANT 'AC1'" );
95 END;
97 BEGIN
98 DECLARE
99 AC2 : ACCP(1) := NEW PRIV (IDENT_INT (2));
100 BEGIN
101 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
102 "OF VARIABLE 'AC2'" );
103 IF AC2 /= NULL THEN
104 COMMENT ("DEFEAT 'AC2' OPTIMIZATION");
105 END IF;
106 END;
107 EXCEPTION
108 WHEN CONSTRAINT_ERROR =>
109 NULL;
110 WHEN OTHERS =>
111 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
112 "OF VARIABLE 'AC2'" );
113 END;
115 BEGIN
116 DECLARE
117 AC3 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (0));
118 BEGIN
119 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
120 "OF CONSTANT 'AC3'" );
121 IF AC3 /= NULL THEN
122 COMMENT ("DEFEAT 'AC3' OPTIMIZATION");
123 END IF;
124 END;
125 EXCEPTION
126 WHEN CONSTRAINT_ERROR =>
127 NULL;
128 WHEN OTHERS =>
129 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
130 "OF CONSTANT 'AC3'" );
131 END;
133 BEGIN
134 DECLARE
135 AC4 : ACCP(1) := NEW PRIV (IDENT_INT (0));
136 BEGIN
137 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
138 "OF VARIABLE 'AC4'" );
139 IF AC4 /= NULL THEN
140 COMMENT ("DEFEAT 'AC4' OPTIMIZATION");
141 END IF;
142 END;
143 EXCEPTION
144 WHEN CONSTRAINT_ERROR =>
145 NULL;
146 WHEN OTHERS =>
147 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
148 "OF VARIABLE 'AC4'" );
149 END;
151 BEGIN
152 DECLARE
153 AC5 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (1));
154 BEGIN
155 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
156 "OF CONSTANT 'AC5'" );
157 IF AC5 /= NULL THEN
158 COMMENT ("DEFEAT 'AC5' OPTIMIZATION");
159 END IF;
160 END;
161 EXCEPTION
162 WHEN CONSTRAINT_ERROR =>
163 NULL;
164 WHEN OTHERS =>
165 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
166 "OF CONSTANT 'AC5'" );
167 END;
169 BEGIN
170 DECLARE
171 AC6 : ACCR(2) := NEW REC (IDENT_INT (1));
172 BEGIN
173 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
174 "OF VARIABLE 'AC6'" );
175 IF AC6 /= NULL THEN
176 COMMENT ("DEFEAT 'AC6' OPTIMIZATION");
177 END IF;
178 END;
179 EXCEPTION
180 WHEN CONSTRAINT_ERROR =>
181 NULL;
182 WHEN OTHERS =>
183 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
184 "OF VARIABLE 'AC6'" );
185 END;
187 BEGIN
188 DECLARE
189 AC7 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (3));
190 BEGIN
191 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
192 "OF CONSTANT 'AC7'" );
193 IF AC7 /= NULL THEN
194 COMMENT ("DEFEAT 'AC7' OPTIMIZATION");
195 END IF;
196 END;
197 EXCEPTION
198 WHEN CONSTRAINT_ERROR =>
199 NULL;
200 WHEN OTHERS =>
201 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
202 "OF CONSTANT 'AC7'" );
203 END;
205 BEGIN
206 DECLARE
207 AC8 : ACCR(2) := NEW REC (IDENT_INT (3));
208 BEGIN
209 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
210 "OF VARIABLE 'AC8'" );
211 IF AC8 /= NULL THEN
212 COMMENT ("DEFEAT 'AC8' OPTIMIZATION");
213 END IF;
214 END;
215 EXCEPTION
216 WHEN CONSTRAINT_ERROR =>
217 NULL;
218 WHEN OTHERS =>
219 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
220 "OF VARIABLE 'AC8'" );
221 END;
223 BEGIN
224 DECLARE
225 AC9 : CONSTANT ACCA(1 .. 2) :=
226 NEW ARR(IDENT_INT(1) .. IDENT_INT (1));
227 BEGIN
228 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
229 "OF CONSTANT 'AC9'" );
230 IF AC9 /= NULL THEN
231 COMMENT ("DEFEAT 'AC9' OPTIMIZATION");
232 END IF;
233 END;
234 EXCEPTION
235 WHEN CONSTRAINT_ERROR =>
236 NULL;
237 WHEN OTHERS =>
238 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
239 "OF CONSTANT 'AC9'" );
240 END;
242 BEGIN
243 DECLARE
244 AC10 : ACCA (1..2) :=
245 NEW ARR(IDENT_INT (1) .. IDENT_INT (1));
246 BEGIN
247 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
248 "OF VARIABLE 'AC10'" );
249 IF AC10 /= NULL THEN
250 COMMENT ("DEFEAT 'AC10' OPTIMIZATION");
251 END IF;
252 END;
253 EXCEPTION
254 WHEN CONSTRAINT_ERROR =>
255 NULL;
256 WHEN OTHERS =>
257 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
258 "OF VARIABLE 'AC10'" );
259 END;
261 BEGIN
262 DECLARE
263 AC11 : CONSTANT ACCA(1..2) :=
264 NEW ARR(IDENT_INT (0) .. IDENT_INT (2));
265 BEGIN
266 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
267 "OF CONSTANT 'AC11'" );
268 IF AC11 /= NULL THEN
269 COMMENT ("DEFEAT 'AC11' OPTIMIZATION");
270 END IF;
271 END;
272 EXCEPTION
273 WHEN CONSTRAINT_ERROR =>
274 NULL;
275 WHEN OTHERS =>
276 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
277 "OF CONSTANT 'AC11'" );
278 END;
280 BEGIN
281 DECLARE
282 AC12 : ACCA(1..2) :=
283 NEW ARR(IDENT_INT (0) .. IDENT_INT (2));
284 BEGIN
285 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
286 "OF VARIABLE 'AC12'" );
287 IF AC12 /= NULL THEN
288 COMMENT ("DEFEAT 'AC12' OPTIMIZATION");
289 END IF;
290 END;
291 EXCEPTION
292 WHEN CONSTRAINT_ERROR =>
293 NULL;
294 WHEN OTHERS =>
295 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
296 "OF VARIABLE 'AC12'" );
297 END;
299 BEGIN
300 DECLARE
301 AC13 : CONSTANT ACCA (1..2) :=
302 NEW ARR(IDENT_INT (2) .. IDENT_INT (3));
303 BEGIN
304 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
305 "OF CONSTANT 'AC13'" );
306 IF AC13 /= NULL THEN
307 COMMENT ("DEFEAT 'AC13' 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 'AC13'" );
316 END;
318 BEGIN
319 DECLARE
320 AC14 : ACCA(1..2) :=
321 NEW ARR(IDENT_INT (2) .. IDENT_INT (3));
322 BEGIN
323 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
324 "OF VARIABLE 'AC14'" );
325 IF AC14 /= NULL THEN
326 COMMENT ("DEFEAT 'AC14' 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 'AC14'" );
335 END;
337 BEGIN
338 DECLARE
339 AC15 : CONSTANT ACCN(1..0) :=
340 NEW ARR(IDENT_INT (0) .. IDENT_INT (0));
341 BEGIN
342 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
343 "OF CONSTANT 'AC15'" );
344 IF AC15 /= NULL THEN
345 COMMENT ("DEFEAT 'AC15' OPTIMIZATION");
346 END IF;
347 END;
348 EXCEPTION
349 WHEN CONSTRAINT_ERROR =>
350 NULL;
351 WHEN OTHERS =>
352 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
353 "OF CONSTANT 'AC15'" );
354 END;
356 BEGIN
357 DECLARE
358 AC16 : ACCN(1..0) :=
359 NEW ARR(IDENT_INT (0) .. IDENT_INT (0));
360 BEGIN
361 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
362 "OF VARIABLE 'AC16'" );
363 IF AC16 /= NULL THEN
364 COMMENT ("DEFEAT 'AC16' OPTIMIZATION");
365 END IF;
366 END;
367 EXCEPTION
368 WHEN CONSTRAINT_ERROR =>
369 NULL;
370 WHEN OTHERS =>
371 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
372 "OF VARIABLE 'AC16'" );
373 END;
375 RESULT;
376 END C32115B;