3 -- Grant of Unlimited Rights
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
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.
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.
34 -- EDS 7/14/98 AVOID OPTIMIZATION
36 WITH REPORT
; USE REPORT
;
41 SUBTYPE LIES
IS BOOLEAN RANGE FALSE .. FALSE;
43 FUNCTION SWITCH
(B
: BOOLEAN) RETURN BOOLEAN IS
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" );
62 B1
: BOOLEAN := SWITCH
(TRUE);
65 TYPE PRIV1
(D
: LIES
) IS PRIVATE;
66 SUBTYPE SUBPRIV
IS PRIV1
(IDENT_BOOL
(TRUE));
68 B2
: BOOLEAN := SWITCH
(FALSE);
71 TYPE PRIV1
(D
: LIES
) IS
82 FAILED
( "NO EXCEPTION RAISED AT THE " &
83 "ELABORATION OF SUBTYPE SUBPRIV " & BOOLEAN'IMAGE(SP
.D
));
87 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
92 WHEN CONSTRAINT_ERROR
=>
96 FAILED
( "EXCEPTION RAISED AT ELABORATION OF " &
97 "FULL TYPE PRIV1 NOT SUBTYPE SUBPRIV" );
100 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
107 B1
: BOOLEAN := SWITCH
(TRUE);
110 TYPE LIM1
(D
: LIES
) IS LIMITED PRIVATE;
111 SUBTYPE SUBLIM
IS LIM1
(IDENT_BOOL
(TRUE));
113 B2
: BOOLEAN := SWITCH
(FALSE);
116 TYPE LIM1
(D
: LIES
) IS
127 FAILED
( "NO EXCEPTION RAISED AT THE " &
128 "ELABORATION OF SUBTYPE SUBLIM " & BOOLEAN'IMAGE(SL
.D
));
132 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
137 WHEN CONSTRAINT_ERROR
=>
141 FAILED
( "EXCEPTION RAISED AT ELABORATION OF " &
142 "FULL TYPE LIM1 NOT SUBTYPE SUBLIM" );
145 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
151 B1
: BOOLEAN := SWITCH
(TRUE);
154 TYPE PRIV2
(D
: LIES
) IS PRIVATE;
155 TYPE PARR
IS ARRAY (1 .. 5) OF
156 PRIV2
(IDENT_BOOL
(TRUE));
158 B2
: BOOLEAN := SWITCH
(FALSE);
161 TYPE PRIV2
(D
: LIES
) IS
172 FAILED
( "NO EXCEPTION RAISED AT THE " &
173 "ELABORATION OF TYPE PARR " & BOOLEAN'IMAGE(PAR
(1).D
));
177 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
182 WHEN CONSTRAINT_ERROR
=>
186 FAILED
( "EXCEPTION RAISED AT ELABORATION OF " &
187 "FULL TYPE PRIV2 NOT TYPE PARR" );
190 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
196 B1
: BOOLEAN := SWITCH
(TRUE);
199 TYPE LIM2
(D
: LIES
) IS LIMITED PRIVATE;
200 TYPE LARR
IS ARRAY (1 .. 5) OF
201 LIM2
(IDENT_BOOL
(TRUE));
203 B2
: BOOLEAN := SWITCH
(FALSE);
206 TYPE LIM2
(D
: LIES
) IS
217 FAILED
( "NO EXCEPTION RAISED AT THE " &
218 "ELABORATION OF TYPE LARR " & BOOLEAN'IMAGE(LAR
(1).D
));
222 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
227 WHEN CONSTRAINT_ERROR
=>
231 FAILED
( "EXCEPTION RAISED AT ELABORATION OF " &
232 "FULL TYPE LIM2 NOT TYPE LARR" );
235 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
241 B1
: BOOLEAN := SWITCH
(TRUE);
244 TYPE PRIV3
(D
: LIES
) IS PRIVATE;
248 X
: PRIV3
(IDENT_BOOL
(TRUE));
251 B2
: BOOLEAN := SWITCH
(FALSE);
254 TYPE PRIV3
(D
: LIES
) IS
265 FAILED
( "NO EXCEPTION RAISED AT THE " &
266 "ELABORATION OF TYPE PRIV4 " & BOOLEAN'IMAGE(P4
.X
.D
));
270 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
275 WHEN CONSTRAINT_ERROR
=>
279 FAILED
( "EXCEPTION RAISED AT ELABORATION OF " &
280 "FULL TYPE PRIV3 NOT TYPE PRIV4" );
283 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
289 B1
: BOOLEAN := SWITCH
(TRUE);
292 TYPE LIM3
(D
: LIES
) IS LIMITED PRIVATE;
296 X
: LIM3
(IDENT_BOOL
(TRUE));
299 B2
: BOOLEAN := SWITCH
(FALSE);
302 TYPE LIM3
(D
: LIES
) IS
313 FAILED
( "NO EXCEPTION RAISED AT THE " &
314 "ELABORATION OF TYPE LIM4 " & BOOLEAN'IMAGE(L4
.X
.D
));
318 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
323 WHEN CONSTRAINT_ERROR
=>
327 FAILED
( "EXCEPTION RAISED AT ELABORATION OF " &
328 "FULL TYPE LIM3 NOT TYPE LIM4" );
331 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
337 B1
: BOOLEAN := SWITCH
(TRUE);
340 TYPE PRIV5
(D
: LIES
) IS PRIVATE;
341 TYPE ACCPRIV
IS ACCESS PRIV5
(IDENT_BOOL
(TRUE));
343 B2
: BOOLEAN := SWITCH
(FALSE);
346 TYPE PRIV5
(D
: LIES
) IS
358 FAILED
( "NO EXCEPTION RAISED AT THE " &
359 "ELABORATION OF TYPE ACCPRIV " & BOOLEAN'IMAGE(ACP
.D
));
363 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
368 WHEN CONSTRAINT_ERROR
=>
372 FAILED
( "EXCEPTION RAISED AT ELABORATION OF " &
373 "FULL TYPE PRIV5 NOT TYPE ACCPRIV" );
376 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
382 B1
: BOOLEAN := SWITCH
(TRUE);
385 TYPE LIM5
(D
: LIES
) IS LIMITED PRIVATE;
386 TYPE ACCLIM
IS ACCESS LIM5
(IDENT_BOOL
(TRUE));
388 B2
: BOOLEAN := SWITCH
(FALSE);
391 TYPE LIM5
(D
: LIES
) IS
403 FAILED
( "NO EXCEPTION RAISED AT THE " &
404 "ELABORATION OF TYPE ACCLIM " & BOOLEAN'IMAGE(ACL
.D
));
408 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
413 WHEN CONSTRAINT_ERROR
=>
417 FAILED
( "EXCEPTION RAISED AT ELABORATION OF " &
418 "FULL TYPE LIM5 NOT TYPE ACCLIM" );
421 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &