annotate gcc/testsuite/ada/acats/tests/c3/c37211b.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 -- C37211B.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 -- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT
kono
parents:
diff changeset
26 -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
kono
parents:
diff changeset
27 -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE
kono
parents:
diff changeset
28 -- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED
kono
parents:
diff changeset
29 -- PRIVATE TYPE, AND THE DISCRIMINANT CONSTRAINT OCCURS AFTER THE FULL
kono
parents:
diff changeset
30 -- DECLARATION OF THE TYPE.
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 -- R.WILLIAMS 8/28/86
kono
parents:
diff changeset
33 -- EDS 7/14/98 AVOID OPTIMIZATION
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 WITH REPORT; USE REPORT;
kono
parents:
diff changeset
36 PROCEDURE C37211B IS
kono
parents:
diff changeset
37
kono
parents:
diff changeset
38 SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 PACKAGE PKG IS
kono
parents:
diff changeset
41 TYPE PRIV (L : LIES) IS PRIVATE;
kono
parents:
diff changeset
42 TYPE LIM (L : LIES) IS LIMITED PRIVATE;
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 PRIVATE
kono
parents:
diff changeset
45 TYPE PRIV (L : LIES) IS
kono
parents:
diff changeset
46 RECORD
kono
parents:
diff changeset
47 NULL;
kono
parents:
diff changeset
48 END RECORD;
kono
parents:
diff changeset
49
kono
parents:
diff changeset
50 TYPE LIM (L : LIES) IS
kono
parents:
diff changeset
51 RECORD
kono
parents:
diff changeset
52 NULL;
kono
parents:
diff changeset
53 END RECORD;
kono
parents:
diff changeset
54 END PKG;
kono
parents:
diff changeset
55
kono
parents:
diff changeset
56 USE PKG;
kono
parents:
diff changeset
57
kono
parents:
diff changeset
58 BEGIN
kono
parents:
diff changeset
59 TEST ( "C37211B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
kono
parents:
diff changeset
60 "A DISCRIMINANT CONSTRAINT IF A VALUE " &
kono
parents:
diff changeset
61 "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
kono
parents:
diff changeset
62 "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
kono
parents:
diff changeset
63 "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
kono
parents:
diff changeset
64 "PRIVATE TYPE, AND THE DISCRIMINANT " &
kono
parents:
diff changeset
65 "CONSTRAINT OCCURS AFTER THE FULL " &
kono
parents:
diff changeset
66 "DECLARATION OF THE TYPE" );
kono
parents:
diff changeset
67
kono
parents:
diff changeset
68 BEGIN
kono
parents:
diff changeset
69 DECLARE
kono
parents:
diff changeset
70 SUBTYPE SUBPRIV IS PRIV (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
71 BEGIN
kono
parents:
diff changeset
72 DECLARE
kono
parents:
diff changeset
73 SP : SUBPRIV;
kono
parents:
diff changeset
74 BEGIN
kono
parents:
diff changeset
75 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
76 "ELABORATION OF SUBTYPE SUBPRIV " &
kono
parents:
diff changeset
77 BOOLEAN'IMAGE(SP.L));
kono
parents:
diff changeset
78 END;
kono
parents:
diff changeset
79 EXCEPTION
kono
parents:
diff changeset
80 WHEN OTHERS =>
kono
parents:
diff changeset
81 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
82 "OBJECT SP" );
kono
parents:
diff changeset
83 END;
kono
parents:
diff changeset
84
kono
parents:
diff changeset
85 EXCEPTION
kono
parents:
diff changeset
86 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
87 NULL;
kono
parents:
diff changeset
88 WHEN OTHERS =>
kono
parents:
diff changeset
89 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
kono
parents:
diff changeset
90 "SUBTYPE SUBPRIV" );
kono
parents:
diff changeset
91 END;
kono
parents:
diff changeset
92
kono
parents:
diff changeset
93 BEGIN
kono
parents:
diff changeset
94 DECLARE
kono
parents:
diff changeset
95 SUBTYPE SUBLIM IS LIM (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
96 BEGIN
kono
parents:
diff changeset
97 DECLARE
kono
parents:
diff changeset
98 SL : SUBLIM;
kono
parents:
diff changeset
99 BEGIN
kono
parents:
diff changeset
100 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
101 "ELABORATION OF SUBTYPE SUBLIM" &
kono
parents:
diff changeset
102 BOOLEAN'IMAGE(SL.L));
kono
parents:
diff changeset
103 END;
kono
parents:
diff changeset
104 EXCEPTION
kono
parents:
diff changeset
105 WHEN OTHERS =>
kono
parents:
diff changeset
106 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
107 "OBJECT SL " );
kono
parents:
diff changeset
108 END;
kono
parents:
diff changeset
109
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 AT ELABORATION OF " &
kono
parents:
diff changeset
115 "SUBTYPE SUBLIM" );
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 TYPE PARR IS ARRAY (1 .. 5) OF PRIV (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
121 BEGIN
kono
parents:
diff changeset
122 DECLARE
kono
parents:
diff changeset
123 PAR : PARR;
kono
parents:
diff changeset
124 BEGIN
kono
parents:
diff changeset
125 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
126 "ELABORATION OF TYPE PARR " &
kono
parents:
diff changeset
127 BOOLEAN'IMAGE(PAR(1).L));
kono
parents:
diff changeset
128 END;
kono
parents:
diff changeset
129 EXCEPTION
kono
parents:
diff changeset
130 WHEN OTHERS =>
kono
parents:
diff changeset
131 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
132 "OBJECT PAR" );
kono
parents:
diff changeset
133 END;
kono
parents:
diff changeset
134
kono
parents:
diff changeset
135 EXCEPTION
kono
parents:
diff changeset
136 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
137 NULL;
kono
parents:
diff changeset
138 WHEN OTHERS =>
kono
parents:
diff changeset
139 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
kono
parents:
diff changeset
140 "TYPE PARR" );
kono
parents:
diff changeset
141 END;
kono
parents:
diff changeset
142
kono
parents:
diff changeset
143 BEGIN
kono
parents:
diff changeset
144 DECLARE
kono
parents:
diff changeset
145 TYPE LARR IS ARRAY (1 .. 10) OF LIM (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
146 BEGIN
kono
parents:
diff changeset
147 DECLARE
kono
parents:
diff changeset
148 LAR : LARR;
kono
parents:
diff changeset
149 BEGIN
kono
parents:
diff changeset
150 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
151 "ELABORATION OF TYPE LARR " &
kono
parents:
diff changeset
152 BOOLEAN'IMAGE(LAR(1).L));
kono
parents:
diff changeset
153 END;
kono
parents:
diff changeset
154 EXCEPTION
kono
parents:
diff changeset
155 WHEN OTHERS =>
kono
parents:
diff changeset
156 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
157 "OBJECT LAR" );
kono
parents:
diff changeset
158 END;
kono
parents:
diff changeset
159
kono
parents:
diff changeset
160 EXCEPTION
kono
parents:
diff changeset
161 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
162 NULL;
kono
parents:
diff changeset
163 WHEN OTHERS =>
kono
parents:
diff changeset
164 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
kono
parents:
diff changeset
165 "TYPE LARR" );
kono
parents:
diff changeset
166 END;
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 BEGIN
kono
parents:
diff changeset
169 DECLARE
kono
parents:
diff changeset
170 TYPE PRIV1 IS
kono
parents:
diff changeset
171 RECORD
kono
parents:
diff changeset
172 X : PRIV (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
173 END RECORD;
kono
parents:
diff changeset
174
kono
parents:
diff changeset
175 BEGIN
kono
parents:
diff changeset
176 DECLARE
kono
parents:
diff changeset
177 P1 : PRIV1;
kono
parents:
diff changeset
178 BEGIN
kono
parents:
diff changeset
179 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
180 "ELABORATION OF TYPE PRIV1 " &
kono
parents:
diff changeset
181 BOOLEAN'IMAGE(P1.X.L));
kono
parents:
diff changeset
182 END;
kono
parents:
diff changeset
183 EXCEPTION
kono
parents:
diff changeset
184 WHEN OTHERS =>
kono
parents:
diff changeset
185 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
186 "OBJECT P1" );
kono
parents:
diff changeset
187 END;
kono
parents:
diff changeset
188
kono
parents:
diff changeset
189 EXCEPTION
kono
parents:
diff changeset
190 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
191 NULL;
kono
parents:
diff changeset
192 WHEN OTHERS =>
kono
parents:
diff changeset
193 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
kono
parents:
diff changeset
194 "TYPE PRIV1" );
kono
parents:
diff changeset
195 END;
kono
parents:
diff changeset
196
kono
parents:
diff changeset
197 BEGIN
kono
parents:
diff changeset
198 DECLARE
kono
parents:
diff changeset
199 TYPE LIM1 IS
kono
parents:
diff changeset
200 RECORD
kono
parents:
diff changeset
201 X : LIM (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
202 END RECORD;
kono
parents:
diff changeset
203
kono
parents:
diff changeset
204 BEGIN
kono
parents:
diff changeset
205 DECLARE
kono
parents:
diff changeset
206 L1 : LIM1;
kono
parents:
diff changeset
207 BEGIN
kono
parents:
diff changeset
208 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
209 "ELABORATION OF TYPE LIM1 " &
kono
parents:
diff changeset
210 BOOLEAN'IMAGE(L1.X.L));
kono
parents:
diff changeset
211 END;
kono
parents:
diff changeset
212 EXCEPTION
kono
parents:
diff changeset
213 WHEN OTHERS =>
kono
parents:
diff changeset
214 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
215 "OBJECT L1" );
kono
parents:
diff changeset
216 END;
kono
parents:
diff changeset
217
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 AT ELABORATION OF " &
kono
parents:
diff changeset
223 "TYPE LIM1" );
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 TYPE ACCPRIV IS ACCESS PRIV (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
229 BEGIN
kono
parents:
diff changeset
230 DECLARE
kono
parents:
diff changeset
231 ACP : ACCPRIV;
kono
parents:
diff changeset
232 BEGIN
kono
parents:
diff changeset
233 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
234 "ELABORATION OF TYPE ACCPRIV " &
kono
parents:
diff changeset
235 BOOLEAN'IMAGE(ACP.L));
kono
parents:
diff changeset
236 END;
kono
parents:
diff changeset
237 EXCEPTION
kono
parents:
diff changeset
238 WHEN OTHERS =>
kono
parents:
diff changeset
239 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
240 "OBJECT ACP" );
kono
parents:
diff changeset
241 END;
kono
parents:
diff changeset
242
kono
parents:
diff changeset
243 EXCEPTION
kono
parents:
diff changeset
244 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
245 NULL;
kono
parents:
diff changeset
246 WHEN OTHERS =>
kono
parents:
diff changeset
247 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
kono
parents:
diff changeset
248 "TYPE ACCPRIV" );
kono
parents:
diff changeset
249 END;
kono
parents:
diff changeset
250
kono
parents:
diff changeset
251 BEGIN
kono
parents:
diff changeset
252 DECLARE
kono
parents:
diff changeset
253 TYPE ACCLIM IS ACCESS LIM (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
254 BEGIN
kono
parents:
diff changeset
255 DECLARE
kono
parents:
diff changeset
256 ACL : ACCLIM;
kono
parents:
diff changeset
257 BEGIN
kono
parents:
diff changeset
258 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
259 "ELABORATION OF TYPE ACCLIM " &
kono
parents:
diff changeset
260 BOOLEAN'IMAGE(ACL.L));
kono
parents:
diff changeset
261 END;
kono
parents:
diff changeset
262 EXCEPTION
kono
parents:
diff changeset
263 WHEN OTHERS =>
kono
parents:
diff changeset
264 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
265 "OBJECT ACL" );
kono
parents:
diff changeset
266 END;
kono
parents:
diff changeset
267
kono
parents:
diff changeset
268 EXCEPTION
kono
parents:
diff changeset
269 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
270 NULL;
kono
parents:
diff changeset
271 WHEN OTHERS =>
kono
parents:
diff changeset
272 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
kono
parents:
diff changeset
273 "TYPE ACCLIM" );
kono
parents:
diff changeset
274 END;
kono
parents:
diff changeset
275
kono
parents:
diff changeset
276 BEGIN
kono
parents:
diff changeset
277 DECLARE
kono
parents:
diff changeset
278 TYPE NEWPRIV IS NEW PRIV (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
279 BEGIN
kono
parents:
diff changeset
280 DECLARE
kono
parents:
diff changeset
281 NP : NEWPRIV;
kono
parents:
diff changeset
282 BEGIN
kono
parents:
diff changeset
283 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
284 "ELABORATION OF TYPE NEWPRIV " &
kono
parents:
diff changeset
285 BOOLEAN'IMAGE(NP.L));
kono
parents:
diff changeset
286 END;
kono
parents:
diff changeset
287 EXCEPTION
kono
parents:
diff changeset
288 WHEN OTHERS =>
kono
parents:
diff changeset
289 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
290 "OBJECT NP" );
kono
parents:
diff changeset
291 END;
kono
parents:
diff changeset
292
kono
parents:
diff changeset
293 EXCEPTION
kono
parents:
diff changeset
294 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
295 NULL;
kono
parents:
diff changeset
296 WHEN OTHERS =>
kono
parents:
diff changeset
297 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
kono
parents:
diff changeset
298 "TYPE NEWPRIV" );
kono
parents:
diff changeset
299 END;
kono
parents:
diff changeset
300
kono
parents:
diff changeset
301 BEGIN
kono
parents:
diff changeset
302 DECLARE
kono
parents:
diff changeset
303 TYPE NEWLIM IS NEW LIM (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
304 BEGIN
kono
parents:
diff changeset
305 DECLARE
kono
parents:
diff changeset
306 NL : NEWLIM;
kono
parents:
diff changeset
307 BEGIN
kono
parents:
diff changeset
308 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
309 "ELABORATION OF TYPE NEWLIM " &
kono
parents:
diff changeset
310 BOOLEAN'IMAGE(NL.L));
kono
parents:
diff changeset
311 END;
kono
parents:
diff changeset
312 EXCEPTION
kono
parents:
diff changeset
313 WHEN OTHERS =>
kono
parents:
diff changeset
314 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
315 "OBJECT NL" );
kono
parents:
diff changeset
316 END;
kono
parents:
diff changeset
317
kono
parents:
diff changeset
318 EXCEPTION
kono
parents:
diff changeset
319 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
320 NULL;
kono
parents:
diff changeset
321 WHEN OTHERS =>
kono
parents:
diff changeset
322 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
kono
parents:
diff changeset
323 "TYPE NEWLIM" );
kono
parents:
diff changeset
324 END;
kono
parents:
diff changeset
325
kono
parents:
diff changeset
326 BEGIN
kono
parents:
diff changeset
327 DECLARE
kono
parents:
diff changeset
328 P : PRIV (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
329 BEGIN
kono
parents:
diff changeset
330 FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
kono
parents:
diff changeset
331 "P " & BOOLEAN'IMAGE(P.L));
kono
parents:
diff changeset
332 EXCEPTION
kono
parents:
diff changeset
333 WHEN OTHERS =>
kono
parents:
diff changeset
334 FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
kono
parents:
diff changeset
335 "CONTAINING P" );
kono
parents:
diff changeset
336 END;
kono
parents:
diff changeset
337
kono
parents:
diff changeset
338 EXCEPTION
kono
parents:
diff changeset
339 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
340 NULL;
kono
parents:
diff changeset
341 WHEN OTHERS =>
kono
parents:
diff changeset
342 FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
343 "P" );
kono
parents:
diff changeset
344 END;
kono
parents:
diff changeset
345
kono
parents:
diff changeset
346 BEGIN
kono
parents:
diff changeset
347 DECLARE
kono
parents:
diff changeset
348 L : LIM (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
349 BEGIN
kono
parents:
diff changeset
350 FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
kono
parents:
diff changeset
351 "L " & BOOLEAN'IMAGE(L.L));
kono
parents:
diff changeset
352 EXCEPTION
kono
parents:
diff changeset
353 WHEN OTHERS =>
kono
parents:
diff changeset
354 FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
kono
parents:
diff changeset
355 "CONTAINING L" );
kono
parents:
diff changeset
356 END;
kono
parents:
diff changeset
357
kono
parents:
diff changeset
358 EXCEPTION
kono
parents:
diff changeset
359 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
360 NULL;
kono
parents:
diff changeset
361 WHEN OTHERS =>
kono
parents:
diff changeset
362 FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
kono
parents:
diff changeset
363 "L" );
kono
parents:
diff changeset
364 END;
kono
parents:
diff changeset
365
kono
parents:
diff changeset
366 BEGIN
kono
parents:
diff changeset
367 DECLARE
kono
parents:
diff changeset
368 TYPE PRIV_NAME IS ACCESS PRIV;
kono
parents:
diff changeset
369 BEGIN
kono
parents:
diff changeset
370 DECLARE
kono
parents:
diff changeset
371 PN : PRIV_NAME := NEW PRIV (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
372 BEGIN
kono
parents:
diff changeset
373 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
374 "DECLARATION OF OBJECT PN " &
kono
parents:
diff changeset
375 BOOLEAN'IMAGE(PN.L));
kono
parents:
diff changeset
376 EXCEPTION
kono
parents:
diff changeset
377 WHEN OTHERS =>
kono
parents:
diff changeset
378 FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
kono
parents:
diff changeset
379 END;
kono
parents:
diff changeset
380 EXCEPTION
kono
parents:
diff changeset
381 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
382 NULL;
kono
parents:
diff changeset
383 WHEN OTHERS =>
kono
parents:
diff changeset
384 FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
kono
parents:
diff changeset
385 "OF OBJECT PN" );
kono
parents:
diff changeset
386 END;
kono
parents:
diff changeset
387 EXCEPTION
kono
parents:
diff changeset
388 WHEN OTHERS =>
kono
parents:
diff changeset
389 FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
kono
parents:
diff changeset
390 "PRIV_NAME" );
kono
parents:
diff changeset
391 END;
kono
parents:
diff changeset
392
kono
parents:
diff changeset
393 BEGIN
kono
parents:
diff changeset
394 DECLARE
kono
parents:
diff changeset
395 TYPE LIM_NAME IS ACCESS LIM;
kono
parents:
diff changeset
396 BEGIN
kono
parents:
diff changeset
397 DECLARE
kono
parents:
diff changeset
398 LN : LIM_NAME := NEW LIM (IDENT_BOOL (TRUE));
kono
parents:
diff changeset
399 BEGIN
kono
parents:
diff changeset
400 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
401 "DECLARATION OF OBJECT LN " &
kono
parents:
diff changeset
402 BOOLEAN'IMAGE(LN.L));
kono
parents:
diff changeset
403 EXCEPTION
kono
parents:
diff changeset
404 WHEN OTHERS =>
kono
parents:
diff changeset
405 FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
kono
parents:
diff changeset
406 END;
kono
parents:
diff changeset
407 EXCEPTION
kono
parents:
diff changeset
408 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
409 NULL;
kono
parents:
diff changeset
410 WHEN OTHERS =>
kono
parents:
diff changeset
411 FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
kono
parents:
diff changeset
412 "OF OBJECT LN" );
kono
parents:
diff changeset
413 END;
kono
parents:
diff changeset
414 EXCEPTION
kono
parents:
diff changeset
415 WHEN OTHERS =>
kono
parents:
diff changeset
416 FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
kono
parents:
diff changeset
417 "LIM_NAME" );
kono
parents:
diff changeset
418 END;
kono
parents:
diff changeset
419
kono
parents:
diff changeset
420 BEGIN
kono
parents:
diff changeset
421 DECLARE
kono
parents:
diff changeset
422 PACKAGE PP IS
kono
parents:
diff changeset
423 TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
kono
parents:
diff changeset
424 PRIVATE;
kono
parents:
diff changeset
425 PRIVATE
kono
parents:
diff changeset
426 TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
kono
parents:
diff changeset
427 RECORD
kono
parents:
diff changeset
428 NULL;
kono
parents:
diff changeset
429 END RECORD;
kono
parents:
diff changeset
430 END PP;
kono
parents:
diff changeset
431
kono
parents:
diff changeset
432 USE PP;
kono
parents:
diff changeset
433 BEGIN
kono
parents:
diff changeset
434 DECLARE
kono
parents:
diff changeset
435 BP : BAD_PRIV;
kono
parents:
diff changeset
436 BEGIN
kono
parents:
diff changeset
437 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
438 "DECLARATION OF OBJECT BP " &
kono
parents:
diff changeset
439 BOOLEAN'IMAGE(BP.D));
kono
parents:
diff changeset
440 EXCEPTION
kono
parents:
diff changeset
441 WHEN OTHERS =>
kono
parents:
diff changeset
442 FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
kono
parents:
diff changeset
443 END;
kono
parents:
diff changeset
444 EXCEPTION
kono
parents:
diff changeset
445 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
446 NULL;
kono
parents:
diff changeset
447 WHEN OTHERS =>
kono
parents:
diff changeset
448 FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
kono
parents:
diff changeset
449 "OF OBJECT BP" );
kono
parents:
diff changeset
450 END;
kono
parents:
diff changeset
451 EXCEPTION
kono
parents:
diff changeset
452 WHEN OTHERS =>
kono
parents:
diff changeset
453 FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
kono
parents:
diff changeset
454 "BAD_PRIV" );
kono
parents:
diff changeset
455 END;
kono
parents:
diff changeset
456
kono
parents:
diff changeset
457 BEGIN
kono
parents:
diff changeset
458 DECLARE
kono
parents:
diff changeset
459 PACKAGE PL IS
kono
parents:
diff changeset
460 TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
kono
parents:
diff changeset
461 LIMITED PRIVATE;
kono
parents:
diff changeset
462 PRIVATE
kono
parents:
diff changeset
463 TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
kono
parents:
diff changeset
464 RECORD
kono
parents:
diff changeset
465 NULL;
kono
parents:
diff changeset
466 END RECORD;
kono
parents:
diff changeset
467 END PL;
kono
parents:
diff changeset
468
kono
parents:
diff changeset
469 USE PL;
kono
parents:
diff changeset
470 BEGIN
kono
parents:
diff changeset
471 DECLARE
kono
parents:
diff changeset
472 BL : BAD_LIM;
kono
parents:
diff changeset
473 BEGIN
kono
parents:
diff changeset
474 FAILED ( "NO EXCEPTION RAISED AT THE " &
kono
parents:
diff changeset
475 "DECLARATION OF OBJECT BL " &
kono
parents:
diff changeset
476 BOOLEAN'IMAGE(BL.D));
kono
parents:
diff changeset
477 EXCEPTION
kono
parents:
diff changeset
478 WHEN OTHERS =>
kono
parents:
diff changeset
479 FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
kono
parents:
diff changeset
480 END;
kono
parents:
diff changeset
481 EXCEPTION
kono
parents:
diff changeset
482 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
483 NULL;
kono
parents:
diff changeset
484 WHEN OTHERS =>
kono
parents:
diff changeset
485 FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
kono
parents:
diff changeset
486 "OF OBJECT BL" );
kono
parents:
diff changeset
487 END;
kono
parents:
diff changeset
488 EXCEPTION
kono
parents:
diff changeset
489 WHEN OTHERS =>
kono
parents:
diff changeset
490 FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
kono
parents:
diff changeset
491 "BAD_LIM" );
kono
parents:
diff changeset
492 END;
kono
parents:
diff changeset
493
kono
parents:
diff changeset
494 RESULT;
kono
parents:
diff changeset
495 END C37211B;