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, AND THE DISCRIMINANT CONSTRAINT OCCURS AFTER THE FULL
30 -- DECLARATION OF THE TYPE.
33 -- EDS 7/14/98 AVOID OPTIMIZATION
35 WITH REPORT
; USE REPORT
;
38 SUBTYPE LIES
IS BOOLEAN RANGE FALSE .. FALSE;
41 TYPE PRIV
(L
: LIES
) IS PRIVATE;
42 TYPE LIM
(L
: LIES
) IS LIMITED PRIVATE;
45 TYPE PRIV
(L
: LIES
) IS
50 TYPE LIM
(L
: LIES
) IS
59 TEST
( "C37211B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
60 "A DISCRIMINANT CONSTRAINT IF A VALUE " &
61 "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
62 "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
63 "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
64 "PRIVATE TYPE, AND THE DISCRIMINANT " &
65 "CONSTRAINT OCCURS AFTER THE FULL " &
66 "DECLARATION OF THE TYPE" );
70 SUBTYPE SUBPRIV
IS PRIV
(IDENT_BOOL
(TRUE));
75 FAILED
( "NO EXCEPTION RAISED AT THE " &
76 "ELABORATION OF SUBTYPE SUBPRIV " &
81 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
86 WHEN CONSTRAINT_ERROR
=>
89 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
95 SUBTYPE SUBLIM
IS LIM
(IDENT_BOOL
(TRUE));
100 FAILED
( "NO EXCEPTION RAISED AT THE " &
101 "ELABORATION OF SUBTYPE SUBLIM" &
102 BOOLEAN'IMAGE(SL
.L
));
106 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
111 WHEN CONSTRAINT_ERROR
=>
114 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
120 TYPE PARR
IS ARRAY (1 .. 5) OF PRIV
(IDENT_BOOL
(TRUE));
125 FAILED
( "NO EXCEPTION RAISED AT THE " &
126 "ELABORATION OF TYPE PARR " &
127 BOOLEAN'IMAGE(PAR
(1).L
));
131 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
136 WHEN CONSTRAINT_ERROR
=>
139 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
145 TYPE LARR
IS ARRAY (1 .. 10) OF LIM
(IDENT_BOOL
(TRUE));
150 FAILED
( "NO EXCEPTION RAISED AT THE " &
151 "ELABORATION OF TYPE LARR " &
152 BOOLEAN'IMAGE(LAR
(1).L
));
156 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
161 WHEN CONSTRAINT_ERROR
=>
164 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
172 X
: PRIV
(IDENT_BOOL
(TRUE));
179 FAILED
( "NO EXCEPTION RAISED AT THE " &
180 "ELABORATION OF TYPE PRIV1 " &
181 BOOLEAN'IMAGE(P1
.X
.L
));
185 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
190 WHEN CONSTRAINT_ERROR
=>
193 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
201 X
: LIM
(IDENT_BOOL
(TRUE));
208 FAILED
( "NO EXCEPTION RAISED AT THE " &
209 "ELABORATION OF TYPE LIM1 " &
210 BOOLEAN'IMAGE(L1
.X
.L
));
214 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
219 WHEN CONSTRAINT_ERROR
=>
222 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
228 TYPE ACCPRIV
IS ACCESS PRIV
(IDENT_BOOL
(TRUE));
233 FAILED
( "NO EXCEPTION RAISED AT THE " &
234 "ELABORATION OF TYPE ACCPRIV " &
235 BOOLEAN'IMAGE(ACP
.L
));
239 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
244 WHEN CONSTRAINT_ERROR
=>
247 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
253 TYPE ACCLIM
IS ACCESS LIM
(IDENT_BOOL
(TRUE));
258 FAILED
( "NO EXCEPTION RAISED AT THE " &
259 "ELABORATION OF TYPE ACCLIM " &
260 BOOLEAN'IMAGE(ACL
.L
));
264 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
269 WHEN CONSTRAINT_ERROR
=>
272 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
278 TYPE NEWPRIV
IS NEW PRIV
(IDENT_BOOL
(TRUE));
283 FAILED
( "NO EXCEPTION RAISED AT THE " &
284 "ELABORATION OF TYPE NEWPRIV " &
285 BOOLEAN'IMAGE(NP
.L
));
289 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
294 WHEN CONSTRAINT_ERROR
=>
297 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
303 TYPE NEWLIM
IS NEW LIM
(IDENT_BOOL
(TRUE));
308 FAILED
( "NO EXCEPTION RAISED AT THE " &
309 "ELABORATION OF TYPE NEWLIM " &
310 BOOLEAN'IMAGE(NL
.L
));
314 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
319 WHEN CONSTRAINT_ERROR
=>
322 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
328 P
: PRIV
(IDENT_BOOL
(TRUE));
330 FAILED
( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
331 "P " & BOOLEAN'IMAGE(P
.L
));
334 FAILED
( "EXCEPTION RAISED INSIDE BLOCK " &
339 WHEN CONSTRAINT_ERROR
=>
342 FAILED
( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
348 L
: LIM
(IDENT_BOOL
(TRUE));
350 FAILED
( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
351 "L " & BOOLEAN'IMAGE(L
.L
));
354 FAILED
( "EXCEPTION RAISED INSIDE BLOCK " &
359 WHEN CONSTRAINT_ERROR
=>
362 FAILED
( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
368 TYPE PRIV_NAME
IS ACCESS PRIV
;
371 PN
: PRIV_NAME
:= NEW PRIV
(IDENT_BOOL
(TRUE));
373 FAILED
( "NO EXCEPTION RAISED AT THE " &
374 "DECLARATION OF OBJECT PN " &
375 BOOLEAN'IMAGE(PN
.L
));
378 FAILED
( "EXCEPTION ATTEMPTING TO USE OBJECT" );
381 WHEN CONSTRAINT_ERROR
=>
384 FAILED
( "WRONG EXCEPTION RAISED AT DECLARATION " &
389 FAILED
( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
395 TYPE LIM_NAME
IS ACCESS LIM
;
398 LN
: LIM_NAME
:= NEW LIM
(IDENT_BOOL
(TRUE));
400 FAILED
( "NO EXCEPTION RAISED AT THE " &
401 "DECLARATION OF OBJECT LN " &
402 BOOLEAN'IMAGE(LN
.L
));
405 FAILED
( "EXCEPTION ATTEMPTING TO USE OBJECT" );
408 WHEN CONSTRAINT_ERROR
=>
411 FAILED
( "WRONG EXCEPTION RAISED AT DECLARATION " &
416 FAILED
( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
423 TYPE BAD_PRIV
(D
: LIES
:= IDENT_BOOL
(TRUE)) IS
426 TYPE BAD_PRIV
(D
: LIES
:= IDENT_BOOL
(TRUE)) IS
437 FAILED
( "NO EXCEPTION RAISED AT THE " &
438 "DECLARATION OF OBJECT BP " &
439 BOOLEAN'IMAGE(BP
.D
));
442 FAILED
( "EXCEPTION ATTEMPTING TO USE OBJECT" );
445 WHEN CONSTRAINT_ERROR
=>
448 FAILED
( "WRONG EXCEPTION RAISED AT DECLARATION " &
453 FAILED
( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
460 TYPE BAD_LIM
(D
: LIES
:= IDENT_BOOL
(TRUE)) IS
463 TYPE BAD_LIM
(D
: LIES
:= IDENT_BOOL
(TRUE)) IS
474 FAILED
( "NO EXCEPTION RAISED AT THE " &
475 "DECLARATION OF OBJECT BL " &
476 BOOLEAN'IMAGE(BL
.D
));
479 FAILED
( "EXCEPTION ATTEMPTING TO USE OBJECT" );
482 WHEN CONSTRAINT_ERROR
=>
485 FAILED
( "WRONG EXCEPTION RAISED AT DECLARATION " &
490 FAILED
( "EXCEPTION RAISED AT ELABORATION OF TYPE " &