1-- C36172A.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 CONSTRAINT_ERROR IS RAISED APPROPRIATELY
26-- ON DISCRETE_RANGES USED AS INDEX_CONSTRAINTS.
27
28-- DAT 2/9/81
29-- SPS 4/7/82
30-- JBG 6/5/85
31
32WITH REPORT;
33PROCEDURE C36172A IS
34
35     USE REPORT;
36
37     SUBTYPE INT_10 IS INTEGER RANGE 1 .. 10;
38     TYPE A IS ARRAY (INT_10 RANGE <> ) OF INTEGER;
39
40     SUBTYPE INT_11 IS INTEGER RANGE 0 .. 11;
41     SUBTYPE NULL_6_4 IS INTEGER RANGE 6 .. 4;
42     SUBTYPE NULL_11_10 IS INTEGER RANGE 11 .. 10;
43     SUBTYPE INT_9_11 IS INTEGER RANGE 9 .. 11;
44
45     TYPE A_9_11 IS ARRAY (9..11) OF BOOLEAN;
46     TYPE A_11_10 IS ARRAY (11 .. 10) OF INTEGER;
47     SUBTYPE A_1_10 IS A(INT_10);
48
49BEGIN
50     TEST ("C36172A", "CONSTRAINT_ERROR IS RAISED APPROPRIATELY" &
51           " FOR INDEX_RANGES");
52
53     BEGIN
54          DECLARE
55               V : A (9 .. 11);
56          BEGIN
57               IF EQUAL (V'FIRST, V'FIRST) THEN
58                    FAILED ("OUT-OF-BOUNDS INDEX_RANGE 1");
59               ELSE
60                    FAILED ("IMPOSSIBLE");
61               END IF;
62          END;
63     EXCEPTION
64          WHEN CONSTRAINT_ERROR => NULL;
65          WHEN OTHERS => FAILED ("WRONG EXCEPTION 1");
66     END;
67
68     BEGIN
69          DECLARE
70               V : A (11 .. 10);
71          BEGIN
72               IF EQUAL (V'FIRST, V'FIRST) THEN
73                    NULL;
74               ELSE
75                    FAILED ("IMPOSSIBLE");
76               END IF;
77          END;
78     EXCEPTION
79          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
80               "RAISED INAPPROPRIATELY 2");
81          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
82               "SHOULD BE 2");
83     END;
84
85     BEGIN
86          DECLARE
87               V : A (6 .. 4);
88          BEGIN
89               IF EQUAL (V'FIRST, V'FIRST) THEN
90                    NULL;
91               ELSE
92                    FAILED ("IMPOSSIBLE");
93               END IF;
94          END;
95     EXCEPTION
96          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
97               "RAISED INAPPROPRIATELY 3");
98          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
99               "SHOULD BE 3");
100     END;
101
102     BEGIN
103          DECLARE
104               V : A (INT_9_11);
105          BEGIN
106               IF EQUAL (V'FIRST, V'FIRST) THEN
107                    FAILED ("OUT-OF-BOUNDS INDEX RANGE 4");
108               ELSE
109                    FAILED ("IMPOSSIBLE");
110               END IF;
111          END;
112     EXCEPTION
113          WHEN CONSTRAINT_ERROR => NULL;
114          WHEN OTHERS => FAILED ("WRONG EXCEPTION 4");
115     END;
116
117     BEGIN
118          DECLARE
119               V : A (NULL_11_10);
120          BEGIN
121               IF EQUAL (V'FIRST, V'FIRST) THEN
122                    NULL;
123               ELSE
124                    FAILED ("IMPOSSIBLE");
125               END IF;
126          END;
127     EXCEPTION
128          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
129               "RAISED INAPPROPRIATELY 5");
130          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
131               "SHOULD BE 5");
132     END;
133
134     BEGIN
135          DECLARE
136               V : A (NULL_6_4);
137          BEGIN
138               IF EQUAL (V'FIRST, V'FIRST) THEN
139                    NULL;
140               ELSE
141                    FAILED ("IMPOSSIBLE");
142               END IF;
143          END;
144     EXCEPTION
145          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
146               "RAISED INAPPROPRIATELY 6");
147          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
148               "SHOULD BE 6");
149     END;
150
151     BEGIN
152          DECLARE
153               V : A (INT_9_11 RANGE 10 .. 11);
154          BEGIN
155               IF EQUAL (V'FIRST, V'FIRST) THEN
156                    FAILED ("BAD NON-NULL INDEX RANGE 7");
157               ELSE
158                    FAILED ("IMPOSSIBLE");
159               END IF;
160          END;
161     EXCEPTION
162          WHEN CONSTRAINT_ERROR => NULL;
163          WHEN OTHERS => FAILED ("WRONG EXCEPTION 7");
164     END;
165
166     BEGIN
167          DECLARE
168               V : A (NULL_11_10 RANGE 11 .. 10);
169          BEGIN
170               IF EQUAL (V'FIRST, V'FIRST) THEN
171                    NULL;
172               ELSE
173                    FAILED ("IMPOSSIBLE");
174               END IF;
175          END;
176     EXCEPTION
177          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
178               "RAISED INAPPROPRIATELY 8");
179          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
180               "SHOULD BE 8");
181     END;
182
183     BEGIN
184          DECLARE
185               V : A (NULL_6_4 RANGE 6 .. 4);
186          BEGIN
187               IF EQUAL (V'FIRST, V'FIRST) THEN
188                    NULL;
189               ELSE
190                    FAILED ("IMPOSSIBLE");
191               END IF;
192          END;
193     EXCEPTION
194          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
195               "RAISED INAPPROPRIATELY 9");
196          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
197               "SHOULD BE 9");
198     END;
199
200     BEGIN
201          DECLARE
202               V : A (A_9_11'RANGE);
203          BEGIN
204               IF EQUAL (V'FIRST, V'FIRST) THEN
205                    FAILED ("BAD INDEX RANGE 10");
206               ELSE
207                    FAILED ("IMPOSSIBLE");
208               END IF;
209          END;
210     EXCEPTION
211          WHEN CONSTRAINT_ERROR => NULL;
212          WHEN OTHERS => FAILED ("WRONG EXCEPTION 10");
213     END;
214
215     BEGIN
216          DECLARE
217               V : A (A_11_10'RANGE);
218          BEGIN
219               IF EQUAL (V'FIRST, V'FIRST) THEN
220                    NULL;
221               ELSE
222                    FAILED ("IMPOSSIBLE");
223               END IF;
224          END;
225     EXCEPTION
226          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
227               "RAISED INAPPROPRIATELY 11");
228          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
229               "SHOULD BE 11");
230     END;
231
232     BEGIN
233          DECLARE
234               V : A (6 .. 4);
235          BEGIN
236               IF EQUAL (V'FIRST, V'FIRST) THEN
237                    NULL;
238               ELSE
239                    FAILED ("IMPOSSIBLE");
240               END IF;
241          END;
242     EXCEPTION
243          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
244               "RAISED INAPPROPRIATELY 12");
245          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
246               "SHOULD BE 12");
247     END;
248
249     RESULT;
250END C36172A;
251