1-- C460010.A
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--
26-- OBJECTIVE:
27--      Check that, for an array aggregate without an others choice assigned
28--      to an object of a constrained array subtype, Constraint_Error is not
29--      raised if the length of each dimension of the aggregate equals the
30--      length of the corresponding dimension of the target object, even if
31--      the bounds of the corresponding index ranges do not match.
32--
33-- TEST DESCRIPTION:
34--      The test verifies that sliding of array bounds is performed on array
35--      aggregates that are part of a larger aggregate, where the bounds of
36--      the corresponding index ranges do not match but the lengths of the
37--      corresponding dimensions are the same. Both aggregates containing
38--      named associations and positional associations are checked. Cases
39--      involving static and nonstatic index constraints, as well as pre-
40--      defined and modular integer index subtypes, are included.
41--
42--
43-- CHANGE HISTORY:
44--      15 Apr 96   SAIC    Prerelease version for ACVC 2.1.
45--      20 Oct 96   SAIC    Removed unnecessary parentheses and type
46--                          conversions.
47--
48--!
49
50with Report;
51pragma Elaborate (Report);
52
53package C460010_0 is
54
55  type Modular_Type is mod 10;  -- Range 0 .. 9.
56
57
58  Two  : Modular_Type := Modular_Type (Report.Ident_Int(2));
59  Four : Modular_Type := Modular_Type (Report.Ident_Int(4));
60
61  type Array_Modular_Index is array (Modular_Type range <>) of Integer;
62
63  subtype Array_Static_Modular_Constraint    is Array_Modular_Index(2..4);
64  subtype Array_Nonstatic_Modular_Constraint is Array_Modular_Index(Two..Four);
65
66end C460010_0;
67
68
69     --==================================================================--
70
71
72with Report;
73pragma Elaborate (Report);
74
75package C460010_1 is
76
77  One  : Integer := Report.Ident_Int(1);
78  Ten  : Integer := Report.Ident_Int(10);
79
80  subtype Integer_Subtype is Integer range One .. Ten;
81
82
83  Two  : Integer := Report.Ident_Int(2);
84  Four : Integer := Report.Ident_Int(4);
85
86  type Array_Integer_Index is array (Integer_Subtype range <>) of Boolean;
87
88  subtype Array_Static_Integer_Constraint    is Array_Integer_Index(2..4);
89  subtype Array_Nonstatic_Integer_Constraint is Array_Integer_Index(Two..Four);
90
91end C460010_1;
92
93
94     --==================================================================--
95
96
97-- Generic equality function:
98
99generic
100   type Operand_Type is private;
101function C460010_2 (L, R : Operand_Type) return Boolean;
102
103
104function C460010_2 (L, R : Operand_Type) return Boolean is
105begin
106   return L = R;
107end C460010_2;
108
109
110     --==================================================================--
111
112
113with C460010_0;
114with C460010_1;
115with C460010_2;
116
117with Report;
118
119procedure C460010 is
120
121   generic function Generic_Equality renames C460010_2;
122
123begin
124   Report.Test ("C460010", "Check that Constraint_Error is not raised if " &
125                "an array aggregate without an others choice is assigned " &
126                "to an object of a constrained array subtype, and the "    &
127                "length of each dimension of the aggregate equals the "    &
128                "length of the corresponding dimension of the target object");
129
130
131               ---=---=---=---=---=---=---=---=---=---=---
132
133
134   declare
135     type Arr is array (1..1) of C460010_0.Array_Static_Modular_Constraint;
136     function Equals is new Generic_Equality (Arr);
137     Target : Arr;
138   begin
139                       ---=---=---=---=---=---=---
140     CASE_1:
141     begin
142        Target := (1 => (1 => 1, 2 => 2, 3 => 3));  -- Named associations.
143
144        if not Equals (Target, Target) then
145             Report.Failed ("Avoid optimization");  -- Never executed.
146        end if;
147      exception
148         when Constraint_Error =>
149            Report.Failed ("Constraint_Error raised: Case 1");
150         when others           =>
151            Report.Failed ("Unexpected exception raised: Case 1");
152      end CASE_1;
153
154                       ---=---=---=---=---=---=---
155
156     CASE_2:
157     begin
158        Target := (1 => (5, 10, 15));  -- Positional associations.
159
160        if not Equals (Target, Target) then
161             Report.Failed ("Avoid optimization");  -- Never executed.
162        end if;
163      exception
164         when Constraint_Error =>
165            Report.Failed ("Constraint_Error raised: Case 2");
166         when others           =>
167            Report.Failed ("Unexpected exception raised: Case 2");
168      end CASE_2;
169
170                       ---=---=---=---=---=---=---
171   end;
172
173
174               ---=---=---=---=---=---=---=---=---=---=---
175
176
177   declare
178     type Rec (Disc : C460010_0.Modular_Type := 4) is record
179       Arr : C460010_0.Array_Modular_Index(2 .. Disc);
180     end record;
181
182     function Equals is new Generic_Equality (Rec);
183     Target : Rec;
184   begin
185                       ---=---=---=---=---=---=---
186     CASE_3:
187     begin
188        Target := (Disc => 4, Arr => (1 => 1, 2 => 2, 3 => 3));  -- Named.
189
190        if not Equals (Target, Target) then
191             Report.Failed ("Avoid optimization");  -- Never executed.
192        end if;
193      exception
194         when Constraint_Error =>
195            Report.Failed ("Constraint_Error raised: Case 3");
196         when others           =>
197            Report.Failed ("Unexpected exception raised: Case 3");
198      end CASE_3;
199
200                       ---=---=---=---=---=---=---
201
202     CASE_4:
203     begin
204        Target := (Disc => 4, Arr => (1 ,2, 3));    -- Positional.
205
206        if not Equals (Target, Target) then
207             Report.Failed ("Avoid optimization");  -- Never executed.
208        end if;
209      exception
210         when Constraint_Error =>
211            Report.Failed ("Constraint_Error raised: Case 4");
212         when others           =>
213            Report.Failed ("Unexpected exception raised: Case 4");
214      end CASE_4;
215
216                       ---=---=---=---=---=---=---
217   end;
218
219
220               ---=---=---=---=---=---=---=---=---=---=---
221
222
223   declare
224     type Arr is array (1..1) of C460010_0.Array_Nonstatic_Modular_Constraint;
225     function Equals is new Generic_Equality (Arr);
226     Target : Arr;
227   begin
228                       ---=---=---=---=---=---=---
229     CASE_5:
230     begin
231        Target := (1 => (1 => 1, 2 => 2, 3 => 3));  -- Named associations.
232
233        if not Equals (Target, Target) then
234             Report.Failed ("Avoid optimization");  -- Never executed.
235        end if;
236      exception
237         when Constraint_Error =>
238            Report.Failed ("Constraint_Error raised: Case 5");
239         when others           =>
240            Report.Failed ("Unexpected exception raised: Case 5");
241      end CASE_5;
242
243                       ---=---=---=---=---=---=---
244
245     CASE_6:
246     begin
247        Target := (1 => ((5, 10, 15)));  -- Positional associations.
248
249        if not Equals (Target, Target) then
250             Report.Failed ("Avoid optimization");  -- Never executed.
251        end if;
252      exception
253         when Constraint_Error =>
254            Report.Failed ("Constraint_Error raised: Case 6");
255         when others           =>
256            Report.Failed ("Unexpected exception raised: Case 6");
257      end CASE_6;
258
259                       ---=---=---=---=---=---=---
260   end;
261
262
263               ---=---=---=---=---=---=---=---=---=---=---
264
265
266   declare
267     type Arr is array (1..1) of C460010_1.Array_Static_Integer_Constraint;
268     function Equals is new Generic_Equality (Arr);
269     Target : Arr;
270   begin
271                       ---=---=---=---=---=---=---
272     CASE_7:
273     begin
274        Target := (1 => (1 => True, 2 => True, 3 => False));  -- Named.
275
276        if not Equals (Target, Target) then
277             Report.Failed ("Avoid optimization");  -- Never executed.
278        end if;
279      exception
280         when Constraint_Error =>
281            Report.Failed ("Constraint_Error raised: Case 7");
282         when others           =>
283            Report.Failed ("Unexpected exception raised: Case 7");
284      end CASE_7;
285
286                       ---=---=---=---=---=---=---
287
288     CASE_8:
289     begin
290        Target := (1 => ((False, False, True)));  -- Positional.
291
292        if not Equals (Target, Target) then
293             Report.Failed ("Avoid optimization");  -- Never executed.
294        end if;
295      exception
296         when Constraint_Error =>
297            Report.Failed ("Constraint_Error raised: Case 8");
298         when others           =>
299            Report.Failed ("Unexpected exception raised: Case 8");
300      end CASE_8;
301
302                       ---=---=---=---=---=---=---
303   end;
304
305
306               ---=---=---=---=---=---=---=---=---=---=---
307
308
309   declare
310     type Arr is array (1..1) of C460010_1.Array_Nonstatic_Integer_Constraint;
311     function Equals is new Generic_Equality (Arr);
312     Target : Arr;
313   begin
314                       ---=---=---=---=---=---=---
315     CASE_9:
316     begin
317        Target := (1 => (1 => True, 2 => True, 3 => False));  -- Named.
318
319        if not Equals (Target, Target) then
320             Report.Failed ("Avoid optimization");  -- Never executed.
321        end if;
322      exception
323         when Constraint_Error =>
324            Report.Failed ("Constraint_Error raised: Case 9");
325         when others           =>
326            Report.Failed ("Unexpected exception raised: Case 9");
327      end CASE_9;
328
329                       ---=---=---=---=---=---=---
330
331     CASE_10:
332     begin
333        Target := (1 => (False, False, True));      -- Positional.
334
335        if not Equals (Target, Target) then
336             Report.Failed ("Avoid optimization");  -- Never executed.
337        end if;
338      exception
339         when Constraint_Error =>
340            Report.Failed ("Constraint_Error raised: Case 10");
341         when others           =>
342            Report.Failed ("Unexpected exception raised: Case 10");
343      end CASE_10;
344
345                       ---=---=---=---=---=---=---
346   end;
347
348
349               ---=---=---=---=---=---=---=---=---=---=---
350
351
352     Report.Result;
353
354end C460010;
355