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 IF AN EXPRESSION GIVES AN INDEX
26 -- VALUE OUTSIDE THE RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND ACCESS
30 -- EDS 8/03/98 AVOID OPTIMIZATION
32 WITH REPORT
; USE REPORT
;
35 SUBTYPE INT
IS INTEGER RANGE 1 .. 5;
36 SUBTYPE BOOL
IS BOOLEAN RANGE TRUE .. TRUE;
37 SUBTYPE CHAR
IS CHARACTER RANGE 'W' .. 'Z';
38 TYPE ARRAY1
IS ARRAY (INT
RANGE <>) OF INTEGER;
39 TYPE ARRAY2
IS ARRAY (3 .. 1) OF INTEGER;
40 TYPE ARRAY3
IS ARRAY (BOOL
RANGE <>) OF INTEGER;
41 TYPE ARRAY4
IS ARRAY (CHAR
RANGE <>) OF INTEGER;
48 TYPE B_REC
(D
: BOOL
) IS
50 A
: ARRAY3
(TRUE .. D
);
53 TYPE NULL_REC
(D
: INT
) IS
58 TYPE NULL_CREC
(D
: CHAR
) IS
60 A
: ARRAY4
(D
.. 'W');
64 TEST
("C41104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF AN " &
65 "EXPRESSION GIVES AN INDEX VALUE OUTSIDE THE " &
66 "RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND " &
70 ARA1
: ARRAY1
(1 .. 5) := (1, 2, 3, 4, 5);
72 ARA1
(IDENT_INT
(0)) := 1;
75 FAILED
("CONSTRAINT_ERROR WAS NOT RAISED - " &
76 INTEGER'IMAGE(ARA1
(1)));
79 FAILED
("EXCEPTION ON ATTEMPT TO USE OBJECT");
83 WHEN CONSTRAINT_ERROR
=>
86 FAILED
("WRONG EXCEPTION RAISED - 1");
88 ------------------------------------------------------------------------
90 TYPE ACC_ARRAY
IS ACCESS ARRAY3
(TRUE .. TRUE);
91 ACC_ARA
: ACC_ARRAY
:= NEW ARRAY3
'(TRUE => 2);
93 ACC_ARA (IDENT_BOOL(FALSE)) := 2;
97 FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
98 INTEGER'IMAGE(ACC_ARA (TRUE)));
101 FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
105 WHEN CONSTRAINT_ERROR =>
108 FAILED ("WRONG EXCEPTION RAISED - 2");
110 ------------------------------------------------------------------------
112 ARA2 : ARRAY4 ('Z
' .. 'Y
');
114 ARA2 (IDENT_CHAR('Y
')) := 3;
116 FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
119 COMMENT ("ARA2 (Y) IS " & INTEGER'IMAGE(ARA2 ('Y
')));
122 FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
126 WHEN CONSTRAINT_ERROR =>
129 FAILED ("WRONG EXCEPTION RAISED - 3");
131 ------------------------------------------------------------------------
133 TYPE ACC_ARRAY IS ACCESS ARRAY2;
134 ACC_ARA : ACC_ARRAY := NEW ARRAY2;
136 ACC_ARA (IDENT_INT(4)) := 4;
138 FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
141 COMMENT ("ACC_ARA (4) IS " & INTEGER'IMAGE(ACC_ARA (4)));
144 FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
148 WHEN CONSTRAINT_ERROR =>
151 FAILED ("WRONG EXCEPTION RAISED - 4");
153 ------------------------------------------------------------------------
155 REC1 : B_REC (TRUE) := (TRUE, A => (TRUE => 5));
157 REC1.A (IDENT_BOOL (FALSE)) := 1;
160 FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
161 INTEGER'IMAGE(REC1.A (TRUE)));
164 FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
168 WHEN CONSTRAINT_ERROR =>
171 FAILED ("WRONG EXCEPTION RAISED - 5");
173 ------------------------------------------------------------------------
175 TYPE ACC_REC IS ACCESS REC (3);
176 ACC_REC1 : ACC_REC := NEW REC'(3, (4, 5, 6));
178 ACC_REC1
.A
(IDENT_INT
(4)) := 4;
181 FAILED
("CONSTRAINT_ERROR WAS NOT RAISED - " &
182 INTEGER'IMAGE(ACC_REC1
.A
(3)));
185 FAILED
("EXCEPTION ON ATTEMPT TO USE OBJECT");
189 WHEN CONSTRAINT_ERROR
=>
192 FAILED
("WRONG EXCEPTION RAISED - 6");
194 ------------------------------------------------------------------------
198 REC1
.A
(IDENT_INT
(2)) := 1;
200 FAILED
("CONSTRAINT_ERROR WAS NOT RAISED - 7");
203 COMMENT
("REC1.A (2) IS " & INTEGER'IMAGE(REC1
.A
(2)));
206 FAILED
("EXCEPTION ON ATTEMPT TO USE OBJECT");
210 WHEN CONSTRAINT_ERROR
=>
213 FAILED
("WRONG EXCEPTION RAISED - 7");
215 ------------------------------------------------------------------------
217 TYPE ACC_REC
IS ACCESS NULL_CREC
('Z');
218 ACC_REC1
: ACC_REC
:= NEW NULL_CREC
('Z');
220 ACC_REC1
.A
(IDENT_CHAR
('A')) := 4;
222 FAILED
("CONSTRAINT_ERROR WAS NOT RAISED - 8");
224 COMMENT
("ACC_REC1.A (A) IS " &
225 INTEGER'IMAGE(ACC_REC1
.A
('A')));
228 FAILED
("EXCEPTION ON ATTEMPT TO USE OBJECT");
232 WHEN CONSTRAINT_ERROR
=>
235 FAILED
("WRONG EXCEPTION RAISED - 8");
237 ------------------------------------------------------------------------