1-- C95086F.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 NOT RAISED BEFORE OR AFTER THE ENTRY
26-- CALL FOR OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
27-- FORM OF A TYPE CONVERSION.  THE FOLLOWING CASES ARE TESTED:
28--   (A) OK CASE.
29--   (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
30--       COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
31--       FORMAL INDEX SUBTYPE.
32--   (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
33--       COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
34--       ARRAYS.
35--   (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
36--       FORMAL INDEX SUBTYPE.
37--   (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
38--       FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
39
40-- RJW 2/3/86
41-- TMB 11/15/95 FIXED INCOMPATIBILITIES WITH ADA95
42-- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
43
44WITH REPORT; USE REPORT;
45PROCEDURE C95086F IS
46
47BEGIN
48     TEST ("C95086F", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
49           "BEFORE OR AFTER THE ENTRY CALL FOR OUT ARRAY PARAMETERS, " &
50           "WITH THE ACTUAL HAVING THE FORM OF A TYPE CONVERSION");
51
52     ---------------------------------------------
53
54     DECLARE -- (A)
55
56          SUBTYPE INDEX IS INTEGER RANGE 1..5;
57          TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
58               OF BOOLEAN;
59          SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3);
60          SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3);
61          AR : ACTUAL;
62          CALLED : BOOLEAN := FALSE;
63
64          TASK T IS
65               ENTRY E (X : OUT FORMAL);
66          END T;
67
68          TASK BODY T IS
69          BEGIN
70               ACCEPT E (X : OUT FORMAL) DO
71                    CALLED := TRUE;
72                    X := (1..3 => (1..3 => TRUE));
73               END E;
74          EXCEPTION
75               WHEN OTHERS =>
76                    FAILED ("EXCEPTION RAISED IN TASK - (A)");
77          END T;
78
79     BEGIN -- (A)
80
81          T.E (FORMAL (AR));
82
83     EXCEPTION
84          WHEN CONSTRAINT_ERROR =>
85               IF NOT CALLED THEN
86                    FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
87               ELSE
88                    FAILED ("EXCEPTION RAISED ON RETURN - (A)");
89               END IF;
90          WHEN OTHERS =>
91               FAILED ("EXCEPTION RAISED - (A)");
92     END; -- (A)
93
94     ---------------------------------------------
95
96     DECLARE -- (B)
97
98          SUBTYPE INDEX IS INTEGER RANGE 1..3;
99          TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN;
100          TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN;
101          AR : ACTUAL;
102          CALLED : BOOLEAN := FALSE;
103
104          TASK T IS
105               ENTRY E (X : OUT FORMAL);
106          END T;
107
108          TASK BODY T IS
109          BEGIN
110               ACCEPT E (X : OUT FORMAL) DO
111                    CALLED := TRUE;
112                    X(3, 3) := TRUE;
113               END E;
114          EXCEPTION
115               WHEN OTHERS =>
116                    FAILED ("EXCEPTION RAISED IN TASK - (B)");
117          END T;
118
119     BEGIN -- (B)
120
121          T.E (FORMAL (AR));
122          IF AR(5, 5) /= TRUE THEN
123               FAILED ("INCORRECT RETURNED VALUE - (B)");
124          END IF;
125
126     EXCEPTION
127          WHEN CONSTRAINT_ERROR =>
128               IF NOT CALLED THEN
129                    FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
130               ELSE
131                    FAILED ("EXCEPTION RAISED ON RETURN - (B)");
132               END IF;
133          WHEN OTHERS =>
134               FAILED ("EXCEPTION RAISED - (B)");
135     END; -- (B)
136
137     ---------------------------------------------
138
139     DECLARE -- (C)
140
141          SUBTYPE INDEX IS INTEGER RANGE 1..5;
142          TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
143               OF CHARACTER;
144          SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3);
145          AR : ARRAY_TYPE (2..1, 1..3);
146          CALLED : BOOLEAN := FALSE;
147
148          TASK T IS
149               ENTRY E (X : OUT FORMAL);
150          END T;
151
152          TASK BODY T IS
153          BEGIN
154               ACCEPT E (X : OUT FORMAL) DO
155                    IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN
156                         FAILED ("WRONG BOUNDS PASSED - (C)");
157                    END IF;
158                    CALLED := TRUE;
159                    X := (2..0 => (1..3 => 'A'));
160               END E;
161          EXCEPTION
162               WHEN OTHERS =>
163                    FAILED ("EXCEPTION RAISED IN TASK - (C)");
164          END T;
165
166     BEGIN -- (C)
167
168          T.E (FORMAL (AR));
169          IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN
170               FAILED ("BOUNDS CHANGED - (C)");
171          END IF;
172
173     EXCEPTION
174          WHEN CONSTRAINT_ERROR =>
175               IF NOT CALLED THEN
176                    FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
177               ELSE
178                    FAILED ("EXCEPTION RAISED ON RETURN - (C)");
179               END IF;
180          WHEN OTHERS =>
181               FAILED ("EXCEPTION RAISED - (C)");
182     END; -- (C)
183
184     ---------------------------------------------
185
186     DECLARE -- (D)
187
188          SUBTYPE INDEX IS INTEGER RANGE 1..3;
189          TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1)
190               OF CHARACTER;
191          TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER;
192          AR : ACTUAL;
193          CALLED : BOOLEAN := FALSE;
194
195          TASK T IS
196               ENTRY E (X : OUT FORMAL);
197          END T;
198
199          TASK BODY T IS
200          BEGIN
201               ACCEPT E (X : OUT FORMAL) DO
202                    IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN
203                         FAILED ("WRONG BOUNDS PASSED - (D)");
204                    END IF;
205                    CALLED := TRUE;
206                    X := (1..3 => (3..1 => 'A'));
207               END E;
208          EXCEPTION
209               WHEN OTHERS =>
210                    FAILED ("EXCEPTION RAISED IN TASK - (D)");
211          END T;
212
213     BEGIN -- (D)
214
215          T.E (FORMAL (AR));
216          IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN
217               FAILED ("BOUNDS CHANGED - (D)");
218          END IF;
219
220     EXCEPTION
221          WHEN CONSTRAINT_ERROR =>
222               IF NOT CALLED THEN
223                    FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
224               ELSE
225                    FAILED ("EXCEPTION RAISED ON RETURN - (D)");
226               END IF;
227          WHEN OTHERS =>
228               FAILED ("EXCEPTION RAISED - (D)");
229     END; -- (D)
230
231     ---------------------------------------------
232
233     DECLARE -- (E)
234
235          SUBTYPE INDEX IS INTEGER RANGE 1..3;
236          TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
237               OF CHARACTER;
238          TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2,
239                                POSITIVE RANGE 1..3) OF CHARACTER;
240          AR : ACTUAL;
241          CALLED : BOOLEAN := FALSE;
242
243          TASK T IS
244               ENTRY E (X : OUT FORMAL);
245          END T;
246
247          TASK BODY T IS
248          BEGIN
249               ACCEPT E (X : OUT FORMAL) DO
250                    IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN
251                         FAILED ("WRONG BOUNDS PASSED - (E)");
252                    END IF;
253                    CALLED := TRUE;
254                    X := (3..1 => (1..3 => ' ' ));
255               END E;
256          EXCEPTION
257               WHEN OTHERS =>
258                    FAILED ("EXCEPTION RAISED IN TASK - (E)");
259          END T;
260
261     BEGIN -- (E)
262
263          T.E (FORMAL (AR));
264          IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN
265               FAILED ("BOUNDS CHANGED - (E)");
266          END IF;
267
268     EXCEPTION
269          WHEN CONSTRAINT_ERROR =>
270               IF NOT CALLED THEN
271                    FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
272               ELSE
273                    FAILED ("EXCEPTION RAISED ON RETURN - (E)");
274               END IF;
275          WHEN OTHERS =>
276               FAILED ("EXCEPTION RAISED - (E)");
277     END; -- (E)
278
279     ---------------------------------------------
280
281     RESULT;
282END C95086F;
283