1-- C37211C.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-- CHECK THAT CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT
26-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
27-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE
28-- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED
29-- PRIVATE TYPE, THE DISCRIMINANT CONSTRAINT OCCURS BEFORE THE FULL
30-- DECLARATION OF THE TYPE, AND THERE ARE NO COMPONENTS OF THE TYPE
31-- DEPENDENT ON THE DISCRIMINANT.
32
33-- R.WILLIAMS 8/28/86
34-- EDS        7/14/98    AVOID OPTIMIZATION
35
36WITH REPORT; USE REPORT;
37PROCEDURE C37211C IS
38
39     GLOBAL : BOOLEAN;
40
41     SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
42
43     FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
44     BEGIN
45          GLOBAL := B;
46          RETURN B;
47     END SWITCH;
48
49BEGIN
50     TEST ( "C37211C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
51                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
52                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
53                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
54                       "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
55                       "PRIVATE TYPE, AND THE DISCRIMINANT " &
56                       "CONSTRAINT OCCURS BEFORE THE FULL " &
57                       "DECLARATION OF THE TYPE" );
58
59     BEGIN
60          DECLARE
61
62               B1 : BOOLEAN := SWITCH (TRUE);
63
64               PACKAGE PP IS
65                    TYPE PRIV1 (D : LIES) IS PRIVATE;
66                    SUBTYPE SUBPRIV IS PRIV1 (IDENT_BOOL (TRUE));
67
68                    B2 : BOOLEAN := SWITCH (FALSE);
69
70               PRIVATE
71                    TYPE PRIV1 (D : LIES) IS
72                         RECORD
73                              NULL;
74                         END RECORD;
75               END PP;
76
77               USE PP;
78          BEGIN
79               DECLARE
80                    SP : SUBPRIV;
81               BEGIN
82                    FAILED ( "NO EXCEPTION RAISED AT THE " &
83                             "ELABORATION OF SUBTYPE SUBPRIV " & BOOLEAN'IMAGE(SP.D));
84               END;
85          EXCEPTION
86               WHEN OTHERS =>
87                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
88                             "OBJECT SP" );
89          END;
90
91     EXCEPTION
92          WHEN CONSTRAINT_ERROR =>
93               IF GLOBAL THEN
94                    NULL;
95               ELSE
96                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
97                             "FULL TYPE PRIV1 NOT SUBTYPE SUBPRIV" );
98               END IF;
99          WHEN OTHERS =>
100               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
101                        "SUBTYPE SUBPRIV" );
102     END;
103
104     BEGIN
105          DECLARE
106
107               B1 : BOOLEAN := SWITCH (TRUE);
108
109               PACKAGE PL IS
110                    TYPE LIM1 (D : LIES) IS LIMITED PRIVATE;
111                    SUBTYPE SUBLIM IS LIM1 (IDENT_BOOL (TRUE));
112
113                    B2 : BOOLEAN := SWITCH (FALSE);
114
115               PRIVATE
116                    TYPE LIM1 (D : LIES) IS
117                         RECORD
118                              NULL;
119                         END RECORD;
120               END PL;
121
122               USE PL;
123          BEGIN
124               DECLARE
125                    SL : SUBLIM;
126               BEGIN
127                    FAILED ( "NO EXCEPTION RAISED AT THE " &
128                             "ELABORATION OF SUBTYPE SUBLIM " & BOOLEAN'IMAGE(SL.D));
129               END;
130          EXCEPTION
131               WHEN OTHERS =>
132                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
133                             "OBJECT SL" );
134          END;
135
136     EXCEPTION
137          WHEN CONSTRAINT_ERROR =>
138               IF GLOBAL THEN
139                    NULL;
140               ELSE
141                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
142                             "FULL TYPE LIM1 NOT SUBTYPE SUBLIM" );
143               END IF;
144          WHEN OTHERS =>
145               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
146                        "SUBTYPE SUBLIM" );
147     END;
148
149     BEGIN
150          DECLARE
151               B1 : BOOLEAN := SWITCH (TRUE);
152
153               PACKAGE PP IS
154                    TYPE PRIV2 (D : LIES) IS PRIVATE;
155                    TYPE PARR IS ARRAY (1 .. 5) OF
156                         PRIV2 (IDENT_BOOL (TRUE));
157
158                    B2 : BOOLEAN := SWITCH (FALSE);
159
160               PRIVATE
161                    TYPE PRIV2 (D : LIES) IS
162                         RECORD
163                              NULL;
164                         END RECORD;
165               END PP;
166
167               USE PP;
168          BEGIN
169               DECLARE
170                    PAR : PARR;
171               BEGIN
172                    FAILED ( "NO EXCEPTION RAISED AT THE " &
173                             "ELABORATION OF TYPE PARR " & BOOLEAN'IMAGE(PAR(1).D));
174               END;
175          EXCEPTION
176               WHEN OTHERS =>
177                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
178                             "OBJECT PAR" );
179          END;
180
181     EXCEPTION
182          WHEN CONSTRAINT_ERROR =>
183               IF GLOBAL THEN
184                    NULL;
185               ELSE
186                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
187                             "FULL TYPE PRIV2 NOT TYPE PARR" );
188               END IF;
189          WHEN OTHERS =>
190               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
191                        "TYPE PARR" );
192     END;
193
194     BEGIN
195          DECLARE
196               B1 : BOOLEAN := SWITCH (TRUE);
197
198               PACKAGE PL IS
199                    TYPE LIM2 (D : LIES) IS LIMITED PRIVATE;
200                    TYPE LARR IS ARRAY (1 .. 5) OF
201                         LIM2 (IDENT_BOOL (TRUE));
202
203                    B2 : BOOLEAN := SWITCH (FALSE);
204
205               PRIVATE
206                    TYPE LIM2 (D : LIES) IS
207                         RECORD
208                              NULL;
209                         END RECORD;
210               END PL;
211
212               USE PL;
213          BEGIN
214               DECLARE
215                    LAR : LARR;
216               BEGIN
217                    FAILED ( "NO EXCEPTION RAISED AT THE " &
218                             "ELABORATION OF TYPE LARR " & BOOLEAN'IMAGE(LAR(1).D));
219               END;
220          EXCEPTION
221               WHEN OTHERS =>
222                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
223                             "OBJECT LAR" );
224          END;
225
226     EXCEPTION
227          WHEN CONSTRAINT_ERROR =>
228               IF GLOBAL THEN
229                    NULL;
230               ELSE
231                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
232                             "FULL TYPE LIM2 NOT TYPE LARR" );
233               END IF;
234          WHEN OTHERS =>
235               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
236                        "TYPE LARR" );
237     END;
238
239     BEGIN
240          DECLARE
241               B1 : BOOLEAN := SWITCH (TRUE);
242
243               PACKAGE PP IS
244                    TYPE PRIV3 (D : LIES) IS PRIVATE;
245
246                    TYPE PRIV4 IS
247                         RECORD
248                              X : PRIV3 (IDENT_BOOL (TRUE));
249                         END RECORD;
250
251                    B2 : BOOLEAN := SWITCH (FALSE);
252
253               PRIVATE
254                    TYPE PRIV3 (D : LIES) IS
255                         RECORD
256                              NULL;
257                         END RECORD;
258               END PP;
259
260               USE PP;
261          BEGIN
262               DECLARE
263                    P4 : PRIV4;
264               BEGIN
265                    FAILED ( "NO EXCEPTION RAISED AT THE " &
266                             "ELABORATION OF TYPE PRIV4 " & BOOLEAN'IMAGE(P4.X.D));
267               END;
268          EXCEPTION
269               WHEN OTHERS =>
270                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
271                             "OBJECT P4" );
272          END;
273
274     EXCEPTION
275          WHEN CONSTRAINT_ERROR =>
276               IF GLOBAL THEN
277                    NULL;
278               ELSE
279                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
280                             "FULL TYPE PRIV3 NOT TYPE PRIV4" );
281               END IF;
282          WHEN OTHERS =>
283               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
284                        "TYPE PRIV4" );
285     END;
286
287     BEGIN
288          DECLARE
289               B1 : BOOLEAN := SWITCH (TRUE);
290
291               PACKAGE PL IS
292                    TYPE LIM3 (D : LIES) IS LIMITED PRIVATE;
293
294                    TYPE LIM4 IS
295                         RECORD
296                              X : LIM3 (IDENT_BOOL (TRUE));
297                         END RECORD;
298
299                    B2 : BOOLEAN := SWITCH (FALSE);
300
301               PRIVATE
302                    TYPE LIM3 (D : LIES) IS
303                         RECORD
304                              NULL;
305                         END RECORD;
306               END PL;
307
308               USE PL;
309          BEGIN
310               DECLARE
311                    L4 : LIM4;
312               BEGIN
313                    FAILED ( "NO EXCEPTION RAISED AT THE " &
314                             "ELABORATION OF TYPE LIM4 " & BOOLEAN'IMAGE(L4.X.D));
315               END;
316          EXCEPTION
317               WHEN OTHERS =>
318                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
319                             "OBJECT L4" );
320          END;
321
322     EXCEPTION
323          WHEN CONSTRAINT_ERROR =>
324               IF GLOBAL THEN
325                    NULL;
326               ELSE
327                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
328                             "FULL TYPE LIM3 NOT TYPE LIM4" );
329               END IF;
330          WHEN OTHERS =>
331               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
332                        "TYPE LIM4" );
333     END;
334
335     BEGIN
336          DECLARE
337               B1 : BOOLEAN := SWITCH (TRUE);
338
339               PACKAGE PP IS
340                    TYPE PRIV5 (D : LIES) IS PRIVATE;
341                    TYPE ACCPRIV IS ACCESS PRIV5 (IDENT_BOOL (TRUE));
342
343                    B2 : BOOLEAN := SWITCH (FALSE);
344
345               PRIVATE
346                    TYPE PRIV5 (D : LIES) IS
347                         RECORD
348                              NULL;
349                         END RECORD;
350               END PP;
351
352               USE PP;
353
354          BEGIN
355               DECLARE
356                    ACP : ACCPRIV;
357               BEGIN
358                    FAILED ( "NO EXCEPTION RAISED AT THE " &
359                             "ELABORATION OF TYPE ACCPRIV " & BOOLEAN'IMAGE(ACP.D));
360               END;
361          EXCEPTION
362               WHEN OTHERS =>
363                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
364                             "OBJECT ACP" );
365          END;
366
367     EXCEPTION
368          WHEN CONSTRAINT_ERROR =>
369               IF GLOBAL THEN
370                    NULL;
371               ELSE
372                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
373                             "FULL TYPE PRIV5 NOT TYPE ACCPRIV" );
374               END IF;
375          WHEN OTHERS =>
376               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
377                        "TYPE ACCPRIV" );
378     END;
379
380     BEGIN
381          DECLARE
382               B1 : BOOLEAN := SWITCH (TRUE);
383
384               PACKAGE PL IS
385                    TYPE LIM5 (D : LIES) IS LIMITED PRIVATE;
386                    TYPE ACCLIM IS ACCESS LIM5 (IDENT_BOOL (TRUE));
387
388                    B2 : BOOLEAN := SWITCH (FALSE);
389
390               PRIVATE
391                    TYPE LIM5 (D : LIES) IS
392                         RECORD
393                              NULL;
394                         END RECORD;
395               END PL;
396
397               USE PL;
398
399          BEGIN
400               DECLARE
401                    ACL : ACCLIM;
402               BEGIN
403                    FAILED ( "NO EXCEPTION RAISED AT THE " &
404                             "ELABORATION OF TYPE ACCLIM " & BOOLEAN'IMAGE(ACL.D));
405               END;
406          EXCEPTION
407               WHEN OTHERS =>
408                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
409                             "OBJECT ACL" );
410          END;
411
412     EXCEPTION
413          WHEN CONSTRAINT_ERROR =>
414               IF GLOBAL THEN
415                    NULL;
416               ELSE
417                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
418                             "FULL TYPE LIM5 NOT TYPE ACCLIM" );
419               END IF;
420          WHEN OTHERS =>
421               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
422                        "TYPE ACCLIM" );
423     END;
424
425     RESULT;
426END C37211C;
427