1-- C43206A.ADA
2
3--                             Grant of Unlimited Rights
4--
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
14--     to do so.
15--
16--                                    DISCLAIMER
17--
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.
24--*
25-- CHECK THAT THE BOUNDS OF A NULL ARRAY AGGREGATE ARE DETERMINED
26-- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK
27-- THAT:
28
29--   A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF
30--      THE LOWER BOUND.
31
32--   B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE
33--      INDEX SUBTYPE FOR NULL RANGES.
34
35--   C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL
36--      BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS
37--      RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE
38--      INDEX SUBTYPE.
39
40-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
41-- ***       remove incompatibilities associated with the transition   -- 9X
42-- ***       to Ada 9X.                                                -- 9X
43
44-- EG  02/02/84
45-- JBG 12/6/84
46-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
47
48WITH REPORT;
49
50PROCEDURE C43206A IS
51
52     USE REPORT;
53
54BEGIN
55
56     TEST("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " &
57                     "DETERMINED BY THE BOUNDS SPECIFIED BY THE " &
58                     "CHOICES");
59
60     DECLARE
61
62          SUBTYPE ST1 IS INTEGER RANGE 10 .. 15;
63          SUBTYPE ST2 IS INTEGER RANGE 1 .. 5;
64
65          TYPE T1 IS ARRAY (ST1 RANGE <>) OF INTEGER;
66          TYPE T2 IS ARRAY (ST2 RANGE <>, ST1 RANGE <>) OF INTEGER;
67
68     BEGIN
69
70CASE_A :  BEGIN
71
72     CASE_A1 : DECLARE
73
74                    PROCEDURE PROC1 (A : T1) IS
75                    BEGIN
76                         IF A'FIRST /= 12 OR A'LAST /= 10 THEN
77                              FAILED ("CASE A1 : INCORRECT BOUNDS");
78                         END IF;
79                    END PROC1;
80
81               BEGIN
82
83                    PROC1((12 .. 10 => -2));
84
85               EXCEPTION
86
87                    WHEN OTHERS =>
88                         FAILED ("CASE A1 : EXCEPTION RAISED");
89
90               END CASE_A1;
91
92     CASE_A2 : DECLARE
93
94                    PROCEDURE PROC1 (A : STRING) IS
95                    BEGIN
96                         IF A'FIRST /= 5 OR A'LAST /= 2 THEN
97                              FAILED ("CASE A2 : INCORRECT BOUNDS");
98                         END IF;
99                    END PROC1;
100
101               BEGIN
102
103                    PROC1 ((5 .. 2 => 'E'));
104
105               EXCEPTION
106
107                    WHEN OTHERS =>
108                         FAILED ("CASE A2 : EXCEPTION RAISED");
109
110               END CASE_A2;
111
112          END CASE_A;
113
114CASE_B :  BEGIN
115
116     CASE_B1 : DECLARE
117
118                    PROCEDURE PROC1 (A : T1; L, U : INTEGER) IS
119                    BEGIN
120                         IF A'FIRST /= L OR A'LAST /= U THEN
121                              FAILED ("CASE B1 : INCORRECT BOUNDS");
122                         END IF;
123                    END PROC1;
124
125               BEGIN
126
127                    BEGIN
128
129                         PROC1 ((5 .. INTEGER'FIRST => -2),
130                                 5, INTEGER'FIRST);
131
132                    EXCEPTION
133
134                         WHEN CONSTRAINT_ERROR =>
135                              FAILED ("CASE B1A : CONSTRAINT_ERROR " &
136                                      "RAISED FOR NULL RANGE");
137                         WHEN OTHERS =>
138                              FAILED ("CASE B1A : EXCEPTION RAISED");
139
140                    END;
141
142                    BEGIN
143
144                         PROC1 ((IDENT_INT(6) .. 3 => -2),6,3);
145
146                    EXCEPTION
147
148                         WHEN OTHERS =>
149                              FAILED ("CASE B1B : EXCEPTION RAISED");
150
151                    END;
152
153               END CASE_B1;
154
155     CASE_B2 : DECLARE
156
157                    PROCEDURE PROC1 (A : STRING) IS
158                    BEGIN
159                         IF A'FIRST /= 1 OR
160                            A'LAST /= INTEGER'FIRST THEN
161                              FAILED ("CASE B2 : INCORRECT BOUNDS");
162                         END IF;
163                    END PROC1;
164
165               BEGIN
166
167                    PROC1 ((1 .. INTEGER'FIRST => ' '));
168
169               EXCEPTION
170
171                    WHEN OTHERS =>
172                         FAILED ("CASE B2 : EXCEPTION RAISED");
173
174               END CASE_B2;
175
176          END CASE_B;
177
178CASE_C :  BEGIN
179
180     CASE_C1 : DECLARE
181
182                    PROCEDURE PROC1 (A : T2) IS
183                    BEGIN
184                         IF A'FIRST(1) /=  5 OR A'LAST(1) /=  3 OR
185                            A'FIRST(2) /= INTEGER'LAST-1 OR
186                            A'LAST(2)  /= INTEGER'LAST THEN
187                              FAILED ("CASE C1 : INCORRECT BOUNDS");
188                         END IF;
189                    END PROC1;
190
191               BEGIN
192
193                    PROC1 ((5 .. 3 =>
194                              (IDENT_INT(INTEGER'LAST-1) ..
195                               IDENT_INT(INTEGER'LAST) => -2)));
196                    FAILED ("CASE C1 : CONSTRAINT_ERROR NOT RAISED");
197
198               EXCEPTION
199
200                    WHEN CONSTRAINT_ERROR =>
201                         NULL;
202
203                    WHEN OTHERS =>
204                         FAILED ("CASE C1 : EXCEPTION RAISED");
205
206               END CASE_C1;
207
208     CASE_C2 : DECLARE
209
210                    PROCEDURE PROC1 (A : T2) IS
211                    BEGIN
212                         IF A'FIRST(1) /=  INTEGER'FIRST OR
213                            A'LAST(1)  /=  INTEGER'FIRST+1 OR
214                            A'FIRST(2) /= 14 OR A'LAST(2) /= 11 THEN
215                              FAILED ("CASE C2 : INCORRECT BOUNDS");
216                         END IF;
217                    END PROC1;
218
219               BEGIN
220
221                    PROC1 ((IDENT_INT(INTEGER'FIRST) ..
222                            IDENT_INT(INTEGER'FIRST+1) =>
223                                    (14 .. IDENT_INT(11) => -2)));
224                    FAILED ("CASE C2 : CONSTRAINT_ERROR NOT RAISED");
225
226               EXCEPTION
227
228                    WHEN CONSTRAINT_ERROR =>
229                         NULL;
230
231                    WHEN OTHERS =>
232                         FAILED ("CASE C2 : EXCEPTION RAISED");
233
234               END CASE_C2;
235
236          END CASE_C;
237
238     END;
239
240     RESULT;
241
242END C43206A;
243