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.
30 -- PWN 10/27/95 REMOVED CHECK WHERE CONSTRAINT RULES HAVE CHANGED.
31 -- PWN 12/03/95 CORRECTED FORMATING PROBLEM.
32 -- TMB 11/20/96 REINTRODUCED CHECK REMOVED ON 10/27 WITH ADA95 CHANGES
33 -- TMB 12/2/96 DELETED CHECK OF CONSTRAINED ACCESS TYPE
34 -- EDS 07/14/98 AVOID OPTIMIZATION
36 WITH REPORT
; USE REPORT
;
39 TYPE REC
(D
: POSITIVE) IS
44 TYPE ACC
IS ACCESS REC
;
46 TEST
( "C37211E", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
47 "A DISCRIMINANT CONSTRAINT IF A VALUE " &
48 "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
49 "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
50 "TYPE MARK DENOTES AN ACCESS TYPE" );
54 SUBTYPE SUBACC
IS ACC
(IDENT_INT
(-1));
59 FAILED
( "NO EXCEPTION RAISED AT THE " &
60 "ELABORATION OF SUBTYPE SUBACC " &
65 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
70 WHEN CONSTRAINT_ERROR
=>
73 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
79 TYPE ARR
IS ARRAY (1 .. 10) OF ACC
(IDENT_INT
(-1));
84 FAILED
( "NO EXCEPTION RAISED AT THE " &
85 "ELABORATION OF TYPE ARR " &
86 INTEGER'IMAGE(AR
(1).D
));
90 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
95 WHEN CONSTRAINT_ERROR
=>
98 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
106 X
: ACC
(IDENT_INT
(-1));
113 FAILED
( "NO EXCEPTION RAISED AT THE " &
114 "ELABORATION OF TYPE REC1 " & INTEGER'IMAGE(R1
.X
.D
));
118 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
123 WHEN CONSTRAINT_ERROR
=>
126 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
132 TYPE ACCA
IS ACCESS ACC
(IDENT_INT
(-1));
137 FAILED
( "NO EXCEPTION RAISED AT THE " &
138 "ELABORATION OF TYPE ACCA " &
139 INTEGER'IMAGE(ACA
.ALL.D
));
143 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
148 WHEN CONSTRAINT_ERROR
=>
151 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
157 TYPE NEWACC
IS NEW ACC
(IDENT_INT
(-1));
162 FAILED
( "NO EXCEPTION RAISED AT THE " &
163 "ELABORATION OF TYPE NEWACC " &
164 INTEGER'IMAGE(NA
.D
));
168 FAILED
( "EXCEPTION RAISED AT DECLARATION OF " &
173 WHEN CONSTRAINT_ERROR
=>
176 FAILED
( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
182 A
: ACC
(IDENT_INT
(-1));
184 FAILED
( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
185 "A " & INTEGER'IMAGE(A
.D
));
188 FAILED
( "EXCEPTION RAISED INSIDE BLOCK " &
193 WHEN CONSTRAINT_ERROR
=>
196 FAILED
( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
203 TYPE BAD_ACC
(D
: POSITIVE := IDENT_INT
(-1)) IS
211 FAILED
( "NO EXCEPTION RAISED AT THE " &
212 "DECLARATION OF OBJECT BAC " &
213 INTEGER'IMAGE(BAC
.D
));
216 FAILED
( "EXCEPTION RAISED INSIDE BLOCK " &
220 WHEN CONSTRAINT_ERROR
=>
223 FAILED
( "WRONG EXCEPTION RAISED AT DECLARATION " &
228 FAILED
( "EXCEPTION RAISED AT ELABORATION OF TYPE " &