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 THE PREFIX OF THE FOLLOWING
26 -- ATTRIBUTES HAS THE VALUE NULL:
27 -- A) 'CALLABLE AND 'TERMINATED FOR A TASK TYPE.
28 -- B) 'FIRST, 'FIRST(N), 'LAST, 'LAST(N), 'LENGTH, 'LENGTH(N),
29 -- 'RANGE, AND 'RANGE(N) FOR AN ARRAY TYPE.
32 -- EDS 07/14/98 AVOID OPTIMIZATION
34 WITH REPORT
; USE REPORT
;
37 SUBTYPE INT
IS INTEGER RANGE 1 .. 10;
43 TYPE ACC_TT
IS ACCESS TT
;
45 TYPE NULL_ARR1
IS ARRAY (2 .. 1) OF INTEGER;
46 TYPE ARRAY1
IS ARRAY (INT
RANGE <>) OF INTEGER;
47 TYPE NULL_ARR2
IS ARRAY (3 .. 1, 2 .. 1) OF INTEGER;
48 TYPE ARRAY2
IS ARRAY (INT
RANGE <>, INT
RANGE <>) OF INTEGER;
49 TYPE ACC_NULL1
IS ACCESS NULL_ARR1
;
50 TYPE ACC_ARR1
IS ACCESS ARRAY1
;
51 TYPE ACC_NULL2
IS ACCESS NULL_ARR2
;
52 TYPE ACC_ARR2
IS ACCESS ARRAY2
;
56 PTR_ARA2
: ACC_ARR1
(1 .. 4);
58 PTR_ARA4
: ACC_ARR2
(1 .. 2, 2 .. 4);
59 BOOL_VAR
: BOOLEAN := FALSE;
60 INT_VAR
: INTEGER := 1;
68 TEST
("C41401A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE " &
69 "PREFIX HAS A VALUE OF NULL FOR THE FOLLOWING " &
70 "ATTRIBUTES: 'CALLABLE, 'TERMINATED, 'FIRST, " &
71 "'LAST, 'LENGTH, AND 'RANGE");
77 BOOL_VAR
:= IDENT_BOOL
(PTR_TT
'CALLABLE);
78 FAILED
("CONSTRAINT_ERROR NOT RAISED - 1 " & BOOLEAN'IMAGE(BOOL_VAR
));
80 WHEN CONSTRAINT_ERROR
=>
83 FAILED
("UNEXPECTED EXCEPTION RAISED - 2");
90 BOOL_VAR
:= IDENT_BOOL
(PTR_TT
'TERMINATED);
91 FAILED
("CONSTRAINT_ERROR NOT RAISED - 3 " & BOOLEAN'IMAGE(BOOL_VAR
));
93 WHEN CONSTRAINT_ERROR
=>
96 FAILED
("UNEXPECTED EXCEPTION RAISED - 4");
100 INT_VAR
:= IDENT_INT
(PTR_ARA1
'FIRST);
101 FAILED
("CONSTRAINT_ERROR NOT RAISED - 5 " & INTEGER'IMAGE(INT_VAR
));
103 WHEN CONSTRAINT_ERROR
=>
106 FAILED
("UNEXPECTED EXCEPTION RAISED - 6");
110 INT_VAR
:= IDENT_INT
(PTR_ARA2
'LAST);
111 FAILED
("CONSTRAINT_ERROR NOT RAISED - 7 " & INTEGER'IMAGE(INT_VAR
));
113 WHEN CONSTRAINT_ERROR
=>
116 FAILED
("UNEXPECTED EXCEPTION RAISED - 8");
120 INT_VAR
:= IDENT_INT
(PTR_ARA1
'LENGTH);
121 FAILED
("CONSTRAINT_ERROR NOT RAISED - 9 " & INTEGER'IMAGE(INT_VAR
));
123 WHEN CONSTRAINT_ERROR
=>
126 FAILED
("UNEXPECTED EXCEPTION RAISED - 10");
131 A
: ARRAY1
(PTR_ARA2
'RANGE);
133 A
(1) := IDENT_INT
(1);
134 FAILED
("CONSTRAINT_ERROR NOT RAISED - 11 " &
135 INTEGER'IMAGE(A
(1)));
138 FAILED
("CONSTRAINT_ERROR NOT RAISED - 11 ");
141 WHEN CONSTRAINT_ERROR
=>
144 FAILED
("UNEXPECTED EXCEPTION RAISED - 12");
148 INT_VAR
:= IDENT_INT
(PTR_ARA3
'FIRST(2));
149 FAILED
("CONSTRAINT_ERROR NOT RAISED - 13 " & INTEGER'IMAGE(INT_VAR
));
151 WHEN CONSTRAINT_ERROR
=>
154 FAILED
("UNEXPECTED EXCEPTION RAISED - 14");
158 INT_VAR
:= IDENT_INT
(PTR_ARA4
'LAST(2));
159 FAILED
("CONSTRAINT_ERROR NOT RAISED - 15 " & INTEGER'IMAGE(INT_VAR
));
161 WHEN CONSTRAINT_ERROR
=>
164 FAILED
("UNEXPECTED EXCEPTION RAISED - 16");
168 INT_VAR
:= IDENT_INT
(PTR_ARA3
'LENGTH(2));
169 FAILED
("CONSTRAINT_ERROR NOT RAISED - 17 " & INTEGER'IMAGE(INT_VAR
));
171 WHEN CONSTRAINT_ERROR
=>
174 FAILED
("UNEXPECTED EXCEPTION RAISED - 18");
179 A
: ARRAY1
(PTR_ARA4
'RANGE(2));
181 A
(1) := IDENT_INT
(1);
182 FAILED
("CONSTRAINT_ERROR NOT RAISED - 19 " &
183 INTEGER'IMAGE(A
(1)));
186 FAILED
("CONSTRAINT_ERROR NOT RAISED - 19 ");
189 WHEN CONSTRAINT_ERROR
=>
192 FAILED
("UNEXPECTED EXCEPTION RAISED - 20");
196 INT_VAR
:= IDENT_INT
(PTR_ARA4
'LAST(1));
197 FAILED
("CONSTRAINT_ERROR NOT RAISED - 21 " & INTEGER'IMAGE(INT_VAR
));
199 WHEN CONSTRAINT_ERROR
=>
202 FAILED
("UNEXPECTED EXCEPTION RAISED - 22");
206 INT_VAR
:= IDENT_INT
(PTR_ARA3
'LENGTH(1));
207 FAILED
("CONSTRAINT_ERROR NOT RAISED - 23 " & INTEGER'IMAGE(INT_VAR
));
209 WHEN CONSTRAINT_ERROR
=>
212 FAILED
("UNEXPECTED EXCEPTION RAISED - 24");