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.
26 -- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A
27 -- CONSTRAINED ACCESS TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED
28 -- WHEN THE VALUE OF THE OPERAND IS NOT NULL AND THE DESIGNATED
29 -- OBJECT HAS INDEX BOUNDS OR DISCRIMINANT VALUES THAT DO NOT EQUAL
30 -- THOSE SPECIFIED IN THE ACCESS TYPE'S CONSTRAINT.
34 -- DWC 07/24/87 REVISED TO MAKE THE ACCESS TYPE UNCONSTRAINED
35 -- AND TO PREVENT DEAD VARIABLE OPTIMIZATION.
37 WITH REPORT
; USE REPORT
;
42 TEST
( "C47009A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
43 "DENOTES A CONSTRAINED ACCESS TYPE, CHECK " &
44 "THAT CONSTRAINT_ERROR IS RAISED WHEN THE " &
45 "VALUE OF THE OPERAND IS NOT NULL AND THE " &
46 "DESIGNATED OBJECT HAS INDEX BOUNDS OR " &
47 "DISCRIMINANT VALUES THAT DO NOT EQUAL THOSE " &
48 "SPECIFIED IN THE ACCESS TYPE'S CONSTRAINT" );
52 TYPE ARR
IS ARRAY (NATURAL RANGE <>) OF INTEGER;
53 TYPE ACC1
IS ACCESS ARR
;
54 SUBTYPE ACC1S
IS ACC1
(IDENT_INT
(1) .. IDENT_INT
(5));
56 B
: ARR
(IDENT_INT
(2) .. IDENT_INT
(6));
59 A
:= ACC1S
'(NEW ARR'(B
'FIRST .. B
'LAST => 0));
61 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
62 "DIFFERENT FROM THOSE OF TYPE ACC1 - 1" );
64 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
65 "DIFFERENT FROM THOSE OF TYPE ACC1 - 2" );
68 WHEN CONSTRAINT_ERROR
=>
71 FAILED
( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
72 "DIFFERENT FROM THOSE OF TYPE ACC1" );
77 TYPE ARR
IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
79 TYPE ACC2
IS ACCESS ARR
;
80 SUBTYPE ACC2S
IS ACC2
(IDENT_INT
(1) .. IDENT_INT
(5),
81 IDENT_INT
(1) .. IDENT_INT
(1));
83 B
: ARR
(IDENT_INT
(1) .. IDENT_INT
(5),
84 IDENT_INT
(2) .. IDENT_INT
(2));
87 A
:= ACC2S
'(NEW ARR'(B
'RANGE => (B
'RANGE (2) => 0)));
89 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
90 "DIFFERENT FROM THOSE OF TYPE ACC2 - 1" );
92 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
93 "DIFFERENT FROM THOSE OF TYPE ACC2 - 2" );
96 WHEN CONSTRAINT_ERROR
=>
99 FAILED
( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
100 "DIFFERENT FROM THOSE OF TYPE ACC2" );
105 TYPE REC
(D
: INTEGER) IS
110 TYPE ACC3
IS ACCESS REC
;
111 SUBTYPE ACC3S
IS ACC3
(IDENT_INT
(3));
113 B
: REC
(IDENT_INT
(5)) := (D
=> (IDENT_INT
(5)));
116 A
:= ACC3S
'(NEW REC'(B
));
118 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
119 "DIFFERENT FROM THOSE OF TYPE ACC3 - 1" );
121 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
122 "DIFFERENT FROM THOSE OF TYPE ACC3 - 2" );
125 WHEN CONSTRAINT_ERROR
=>
128 FAILED
( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
129 "DIFFERENT FROM THOSE OF TYPE ACC3" );
134 TYPE REC
(D1
,D2
: INTEGER) IS
139 TYPE ACC4
IS ACCESS REC
;
140 SUBTYPE ACC4S
IS ACC4
(IDENT_INT
(4), IDENT_INT
(5));
142 B
: REC
(IDENT_INT
(5), IDENT_INT
(4)) :=
143 (D1
=> (IDENT_INT
(5)), D2
=> (IDENT_INT
(4)));
146 A
:= ACC4S
'(NEW REC'(B
));
148 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
149 "DIFFERENT FROM THOSE OF TYPE ACC4 - 1" );
151 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
152 "DIFFERENT FROM THOSE OF TYPE ACC4 - 2" );
155 WHEN CONSTRAINT_ERROR
=>
158 FAILED
( "WRONG EXCEPTION RAISED FOR DISC VALUES " &
159 "DIFFERENT FROM THOSE OF TYPE ACC4" );
165 TYPE REC
(D
: INTEGER) IS PRIVATE;
169 TYPE REC
(D
: INTEGER) IS
174 B
: CONSTANT REC
:= (D
=> (IDENT_INT
(4)));
179 TYPE ACC5
IS ACCESS REC
;
180 SUBTYPE ACC5S
IS ACC5
(IDENT_INT
(3));
184 A
:= ACC5S
'(NEW REC'(B
));
186 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
187 "DIFFERENT FROM THOSE OF TYPE ACC5 - 1" );
189 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
190 "DIFFERENT FROM THOSE OF TYPE ACC5 - 2" );
193 WHEN CONSTRAINT_ERROR
=>
196 FAILED
( "WRONG EXCEPTION RAISED FOR DISC VALUES " &
197 "DIFFERENT FROM THOSE OF TYPE ACC5" );
203 TYPE REC
(D
: INTEGER) IS LIMITED PRIVATE;
204 TYPE ACC6
IS ACCESS REC
;
205 SUBTYPE ACC6S
IS ACC6
(IDENT_INT
(6));
207 FUNCTION F
RETURN ACC6
;
209 TYPE REC
(D
: INTEGER) IS
217 FUNCTION F
RETURN ACC6
IS
219 RETURN NEW REC
'(D => IDENT_INT (5));
224 PACKAGE PKG2 IS END PKG2;
234 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
235 "DIFFERENT FROM THOSE OF TYPE ACC6 - 1" );
237 FAILED
( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
238 "DIFFERENT FROM THOSE OF TYPE ACC6 - 2" );
241 WHEN CONSTRAINT_ERROR
=>
244 FAILED
( "WRONG EXCEPTION RAISED FOR DISC " &
245 "VALUES DIFFERENT FROM THOSE OF TYPE " &