1-- C95085C.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 UNDER THE
26-- APPROPRIATE CIRCUMSTANCES FOR ARRAY PARAMETERS IN ENTRY CALLS,
27-- NAMELY WHEN THE ACTUAL BOUNDS DON'T MATCH THE FORMAL BOUNDS
28-- (BEFORE THE CALL FOR ALL MODES).
29-- SUBTESTS ARE:
30--      (A) IN MODE, ONE DIMENSION, STATIC AGGREGATE.
31--      (B) IN MODE, TWO DIMENSIONS, DYNAMIC AGGREGATE.
32--      (C) IN MODE, TWO DIMENSIONS, DYNAMIC VARIABLE.
33--      (D) IN OUT MODE, THREE DIMENSIONS, STATIC VARIABLE.
34--      (E) OUT MODE, ONE DIMENSION, DYNAMIC VARIABLE.
35--      (F) IN OUT MODE, NULL STRING AGGREGATE.
36--      (G) IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE (OK CASE).
37--          IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE.
38
39-- JWC 10/28/85
40-- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
41
42WITH REPORT; USE REPORT;
43PROCEDURE C95085C IS
44
45BEGIN
46     TEST ("C95085C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
47                      "ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
48
49     --------------------------------------------------
50
51     DECLARE -- (A)
52          SUBTYPE ST IS STRING (1..3);
53
54          TASK TSK IS
55               ENTRY E (A : ST);
56          END TSK;
57
58          TASK BODY TSK IS
59          BEGIN
60               SELECT
61                    ACCEPT E (A : ST) DO
62                         FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
63                    END E;
64               OR
65                    TERMINATE;
66               END SELECT;
67          EXCEPTION
68               WHEN OTHERS =>
69                    FAILED ("EXCEPTION RAISED IN TASK - (A)");
70          END TSK;
71
72     BEGIN -- (A)
73
74          TSK.E ("AB");
75          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (A)");
76
77     EXCEPTION
78          WHEN CONSTRAINT_ERROR =>
79               NULL;
80          WHEN OTHERS =>
81               FAILED ("WRONG EXCEPTION RAISED - (A)");
82     END; -- (A)
83
84     --------------------------------------------------
85
86     DECLARE -- (B)
87
88          SUBTYPE S IS INTEGER RANGE 1..3;
89          TYPE T IS ARRAY (S,S) OF INTEGER;
90
91          TASK TSK IS
92               ENTRY E (A : T);
93          END TSK;
94
95          TASK BODY TSK IS
96          BEGIN
97               SELECT
98                    ACCEPT E (A : T) DO
99                         FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
100                    END E;
101               OR
102                    TERMINATE;
103               END SELECT;
104          EXCEPTION
105               WHEN OTHERS =>
106                    FAILED ("EXCEPTION RAISED IN TASK - (B)");
107          END TSK;
108
109     BEGIN -- (B)
110
111          TSK.E ((1..3 => (1..IDENT_INT(2) => 0)));
112          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (B)");
113
114     EXCEPTION
115          WHEN CONSTRAINT_ERROR =>
116               NULL;
117          WHEN OTHERS =>
118               FAILED ("WRONG EXCEPTION RAISED - (B)");
119     END; -- (B)
120
121     --------------------------------------------------
122
123     DECLARE -- (C)
124
125          SUBTYPE S IS INTEGER RANGE 1..5;
126          TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF INTEGER;
127          SUBTYPE ST IS T (1..3,1..3);
128          V : T (1..IDENT_INT(2), 1..3) :=
129                (1..IDENT_INT(2) => (1..3 => 0));
130
131          TASK TSK IS
132               ENTRY E (A :ST);
133          END TSK;
134
135          TASK BODY TSK IS
136          BEGIN
137               SELECT
138                    ACCEPT E (A :ST) DO
139                         FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
140                    END E;
141               OR
142                    TERMINATE;
143               END SELECT;
144          EXCEPTION
145               WHEN OTHERS =>
146                    FAILED ("EXCEPTION RAISED IN TASK - (C)");
147          END TSK;
148
149     BEGIN -- (C)
150
151          TSK.E (V);
152          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (C)");
153
154     EXCEPTION
155          WHEN CONSTRAINT_ERROR =>
156               NULL;
157          WHEN OTHERS =>
158               FAILED ("WRONG EXCEPTION RAISED - (C)");
159     END; -- (C)
160
161     --------------------------------------------------
162
163     DECLARE -- (D)
164
165          SUBTYPE S IS INTEGER RANGE 1..5;
166          TYPE T IS ARRAY (S RANGE <>, S RANGE <>, S RANGE <>) OF
167                    INTEGER;
168          SUBTYPE ST IS T (1..3, 1..3, 1..3);
169          V : T (1..3, 1..2, 1..3) :=
170                (1..3 => (1..2 => (1..3 => 0)));
171
172          TASK TSK IS
173               ENTRY E (A : IN OUT ST);
174          END TSK;
175
176          TASK BODY TSK IS
177          BEGIN
178               SELECT
179                    ACCEPT E (A : IN OUT ST) DO
180                         FAILED ("EXCEPTION NOT RAISED ON CALL - (D)");
181                    END E;
182               OR
183                    TERMINATE;
184               END SELECT;
185          EXCEPTION
186               WHEN OTHERS =>
187                    FAILED ("EXCEPTION RAISED IN TASK - (D)");
188          END TSK;
189
190     BEGIN -- (D)
191
192          TSK.E (V);
193          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (D)");
194
195     EXCEPTION
196          WHEN CONSTRAINT_ERROR =>
197               NULL;
198          WHEN OTHERS =>
199               FAILED ("WRONG EXCEPTION RAISED - (D)");
200     END; -- (D)
201
202     --------------------------------------------------
203
204
205     DECLARE -- (G)
206
207          SUBTYPE S IS INTEGER RANGE 1..5;
208          TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF CHARACTER;
209          SUBTYPE ST IS T (2..1, 2..1);
210          V : T (2..1, 2..1) := (2..1 => (2..1 => ' '));
211
212          TASK TSK IS
213               ENTRY E (A : IN OUT ST);
214          END TSK;
215
216          TASK BODY TSK IS
217          BEGIN
218               SELECT
219                    ACCEPT E (A : IN OUT ST)  DO
220                         COMMENT ("OK CASE CALLED CORRECTLY");
221                    END E;
222               OR
223                    TERMINATE;
224               END SELECT;
225          EXCEPTION
226               WHEN OTHERS =>
227                    FAILED ("EXCEPTION RAISED IN TASK - (G)");
228          END TSK;
229
230     BEGIN -- (G)
231
232          TSK.E (V);
233
234     EXCEPTION
235          WHEN CONSTRAINT_ERROR =>
236               FAILED ("CONSTRAINT_ERROR RAISED ON OK CASE - (G)");
237          WHEN OTHERS =>
238               FAILED ("OTHER EXCEPTION RAISED ON OK CASE - (G)");
239     END; -- (G)
240
241     --------------------------------------------------
242
243
244     RESULT;
245END C95085C;
246