OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c460010.a] - Blame information for rev 149

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- 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
 
50
with Report;
51
pragma Elaborate (Report);
52
 
53
package 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
 
66
end C460010_0;
67
 
68
 
69
     --==================================================================--
70
 
71
 
72
with Report;
73
pragma Elaborate (Report);
74
 
75
package 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
 
91
end C460010_1;
92
 
93
 
94
     --==================================================================--
95
 
96
 
97
-- Generic equality function:
98
 
99
generic
100
   type Operand_Type is private;
101
function C460010_2 (L, R : Operand_Type) return Boolean;
102
 
103
 
104
function C460010_2 (L, R : Operand_Type) return Boolean is
105
begin
106
   return L = R;
107
end C460010_2;
108
 
109
 
110
     --==================================================================--
111
 
112
 
113
with C460010_0;
114
with C460010_1;
115
with C460010_2;
116
 
117
with Report;
118
 
119
procedure C460010 is
120
 
121
   generic function Generic_Equality renames C460010_2;
122
 
123
begin
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
 
354
end C460010;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.