1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
-- C43206A.ADA
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
-- CHECK THAT THE BOUNDS OF A NULL ARRAY AGGREGATE ARE DETERMINED
-- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK
-- THAT:
-- A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF
-- THE LOWER BOUND.
-- B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE
-- INDEX SUBTYPE FOR NULL RANGES.
-- C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL
-- BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS
-- RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE
-- INDEX SUBTYPE.
-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X
-- *** remove incompatibilities associated with the transition -- 9X
-- *** to Ada 9X. -- 9X
-- EG 02/02/84
-- JBG 12/6/84
-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
WITH REPORT;
PROCEDURE C43206A IS
USE REPORT;
BEGIN
TEST("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " &
"DETERMINED BY THE BOUNDS SPECIFIED BY THE " &
"CHOICES");
DECLARE
SUBTYPE ST1 IS INTEGER RANGE 10 .. 15;
SUBTYPE ST2 IS INTEGER RANGE 1 .. 5;
TYPE T1 IS ARRAY (ST1 RANGE <>) OF INTEGER;
TYPE T2 IS ARRAY (ST2 RANGE <>, ST1 RANGE <>) OF INTEGER;
BEGIN
CASE_A : BEGIN
CASE_A1 : DECLARE
PROCEDURE PROC1 (A : T1) IS
BEGIN
IF A'FIRST /= 12 OR A'LAST /= 10 THEN
FAILED ("CASE A1 : INCORRECT BOUNDS");
END IF;
END PROC1;
BEGIN
PROC1((12 .. 10 => -2));
EXCEPTION
WHEN OTHERS =>
FAILED ("CASE A1 : EXCEPTION RAISED");
END CASE_A1;
CASE_A2 : DECLARE
PROCEDURE PROC1 (A : STRING) IS
BEGIN
IF A'FIRST /= 5 OR A'LAST /= 2 THEN
FAILED ("CASE A2 : INCORRECT BOUNDS");
END IF;
END PROC1;
BEGIN
PROC1 ((5 .. 2 => 'E'));
EXCEPTION
WHEN OTHERS =>
FAILED ("CASE A2 : EXCEPTION RAISED");
END CASE_A2;
END CASE_A;
CASE_B : BEGIN
CASE_B1 : DECLARE
PROCEDURE PROC1 (A : T1; L, U : INTEGER) IS
BEGIN
IF A'FIRST /= L OR A'LAST /= U THEN
FAILED ("CASE B1 : INCORRECT BOUNDS");
END IF;
END PROC1;
BEGIN
BEGIN
PROC1 ((5 .. INTEGER'FIRST => -2),
5, INTEGER'FIRST);
EXCEPTION
WHEN CONSTRAINT_ERROR =>
FAILED ("CASE B1A : CONSTRAINT_ERROR " &
"RAISED FOR NULL RANGE");
WHEN OTHERS =>
FAILED ("CASE B1A : EXCEPTION RAISED");
END;
BEGIN
PROC1 ((IDENT_INT(6) .. 3 => -2),6,3);
EXCEPTION
WHEN OTHERS =>
FAILED ("CASE B1B : EXCEPTION RAISED");
END;
END CASE_B1;
CASE_B2 : DECLARE
PROCEDURE PROC1 (A : STRING) IS
BEGIN
IF A'FIRST /= 1 OR
A'LAST /= INTEGER'FIRST THEN
FAILED ("CASE B2 : INCORRECT BOUNDS");
END IF;
END PROC1;
BEGIN
PROC1 ((1 .. INTEGER'FIRST => ' '));
EXCEPTION
WHEN OTHERS =>
FAILED ("CASE B2 : EXCEPTION RAISED");
END CASE_B2;
END CASE_B;
CASE_C : BEGIN
CASE_C1 : DECLARE
PROCEDURE PROC1 (A : T2) IS
BEGIN
IF A'FIRST(1) /= 5 OR A'LAST(1) /= 3 OR
A'FIRST(2) /= INTEGER'LAST-1 OR
A'LAST(2) /= INTEGER'LAST THEN
FAILED ("CASE C1 : INCORRECT BOUNDS");
END IF;
END PROC1;
BEGIN
PROC1 ((5 .. 3 =>
(IDENT_INT(INTEGER'LAST-1) ..
IDENT_INT(INTEGER'LAST) => -2)));
FAILED ("CASE C1 : CONSTRAINT_ERROR NOT RAISED");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("CASE C1 : EXCEPTION RAISED");
END CASE_C1;
CASE_C2 : DECLARE
PROCEDURE PROC1 (A : T2) IS
BEGIN
IF A'FIRST(1) /= INTEGER'FIRST OR
A'LAST(1) /= INTEGER'FIRST+1 OR
A'FIRST(2) /= 14 OR A'LAST(2) /= 11 THEN
FAILED ("CASE C2 : INCORRECT BOUNDS");
END IF;
END PROC1;
BEGIN
PROC1 ((IDENT_INT(INTEGER'FIRST) ..
IDENT_INT(INTEGER'FIRST+1) =>
(14 .. IDENT_INT(11) => -2)));
FAILED ("CASE C2 : CONSTRAINT_ERROR NOT RAISED");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("CASE C2 : EXCEPTION RAISED");
END CASE_C2;
END CASE_C;
END;
RESULT;
END C43206A;
|
