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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c360002.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C360002.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 modular types may be used as array indices.
28
--
29
--      Check that if aliased appears in the component_definition of an
30
--      array_type that each component of the array is aliased.
31
--
32
--      Check that references to aliased array objects produce correct
33
--      results, and that out-of-bounds indexing correctly produces
34
--      Constraint_Error.
35
--
36
-- TEST DESCRIPTION:
37
--      This test defines several array types and subtypes indexed by modular
38
--      types; some aliased some not, some with aliased components, some not.
39
--
40
--      It then checks that assignments move the correct data.
41
--
42
--
43
-- CHANGE HISTORY:
44
--      28 SEP 95   SAIC   Initial version
45
--      23 APR 96   SAIC   Doc fixes, fixed constrained/unconstrained conflict
46
--      13 FEB 97   PWB.CTA Removed illegal declarations and affected code
47
--!
48
 
49
------------------------------------------------------------------- C360002
50
 
51
with Report;
52
 
53
procedure C360002 is
54
 
55
  Verbose : Boolean := Report.Ident_Bool( False );
56
 
57
  type Mod_128 is mod 128;
58
 
59
  function Ident_128( I: Integer ) return Mod_128 is
60
  begin
61
    return Mod_128( Report.Ident_Int( I ) );
62
  end Ident_128;
63
 
64
  type Unconstrained_Array
65
       is array( Mod_128 range <> ) of Integer;
66
 
67
  type Unconstrained_Array_Aliased
68
       is array( Mod_128 range <> ) of aliased Integer;
69
 
70
  type Access_All_Unconstrained_Array
71
       is access all Unconstrained_Array;
72
 
73
  type Access_All_Unconstrained_Array_Aliased
74
       is access all Unconstrained_Array_Aliased;
75
 
76
  subtype Array_01_10
77
          is Unconstrained_Array(01..10);
78
 
79
  subtype Array_11_20
80
          is Unconstrained_Array(11..20);
81
 
82
  subtype Array_Aliased_01_10
83
          is Unconstrained_Array_Aliased(01..10);
84
 
85
  subtype Array_Aliased_11_20
86
          is Unconstrained_Array_Aliased(11..20);
87
 
88
  subtype Access_All_01_10_Array
89
          is Access_All_Unconstrained_Array(01..10);
90
 
91
  subtype Access_All_01_10_Array_Aliased
92
          is Access_All_Unconstrained_Array_Aliased(01..10);
93
 
94
  subtype Access_All_11_20_Array
95
          is Access_All_Unconstrained_Array(11..20);
96
 
97
  subtype Access_All_11_20_Array_Aliased
98
          is Access_All_Unconstrained_Array_Aliased(11..20);
99
 
100
 
101
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
102
 
103
  -- these 'filler' functions create unique values for every element that
104
  -- is used and/or tested in this test.
105
 
106
  Well_Bottom : Integer := 0;
107
 
108
  function Filler( Size : Mod_128 ) return Unconstrained_Array is
109
    It : Unconstrained_Array( 0..Size-1 );
110
  begin
111
    for Eyes in It'Range loop
112
      It(Eyes) := Integer( Eyes ) + Well_Bottom;
113
    end loop;
114
    Well_Bottom := Well_Bottom + It'Length;
115
    return It;
116
  end Filler;
117
 
118
  function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
119
    It : Unconstrained_Array_Aliased( 0..Size-1 );
120
  begin
121
    for Ayes in It'Range loop
122
      It(Ayes) := Integer( Ayes ) + Well_Bottom;
123
    end loop;
124
    Well_Bottom := Well_Bottom + It'Length;
125
    return It;
126
  end Filler;
127
 
128
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
129
 
130
  An_Integer : Integer;
131
 
132
  type AAI is access all Integer;
133
 
134
  An_Integer_Access : AAI;
135
 
136
  Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
137
 
138
  Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
139
 
140
  Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
141
 
142
  Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
143
 
144
  Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
145
 
146
  Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
147
 
148
  Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
149
                                   := Filler(10);               -- 60..69
150
 
151
  Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
152
                                   := Filler(10);               -- 70..79
153
 
154
  Check_Item            : Access_All_Unconstrained_Array;
155
 
156
  Check_Aliased_Item    : Access_All_Unconstrained_Array_Aliased;
157
 
158
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
159
 
160
  procedure Fail( Message : String; CI, SB : Integer ) is
161
  begin
162
    Report.Failed("Wrong value passed " & Message);
163
    if Verbose then
164
      Report.Comment("got" & Integer'Image(CI) &
165
                     " should be" & Integer'Image(SB) );
166
    end if;
167
  end Fail;
168
 
169
  procedure Check_Array_01_10( Checked_Item : Array_01_10;
170
                               Low_SB       : Integer ) is
171
  begin
172
    for Index in Checked_Item'Range loop
173
      if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
174
        Fail("unaliased 1..10", Checked_Item(Index),
175
                                (Low_SB +Integer(Index)-1));
176
      end if;
177
    end loop;
178
  end Check_Array_01_10;
179
 
180
  procedure Check_Array_11_20( Checked_Item : Array_11_20;
181
                               Low_SB       : Integer ) is
182
  begin
183
    for Index in Checked_Item'Range loop
184
      if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
185
        Fail("unaliased 11..20", Checked_Item(Index),
186
                                 (Low_SB +Integer(Index)-11));
187
      end if;
188
    end loop;
189
 end Check_Array_11_20;
190
 
191
  procedure Check_Single_Integer( The_Integer, SB : Integer;
192
                                  Message         : String ) is
193
  begin
194
    if The_Integer /= SB then
195
      Report.Failed("Wrong integer value for " & Message );
196
    end if;
197
  end Check_Single_Integer;
198
 
199
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
200
 
201
begin  -- Main test procedure.
202
 
203
  Report.Test ("C360002", "Check that modular types may be used as array " &
204
                          "indices.  Check that if aliased appears in " &
205
                          "the component_definition of an array_type that " &
206
                          "each component of the array is aliased.  Check " &
207
                          "that references to aliased array objects " &
208
                          "produce correct results, and that out of bound " &
209
                          "references to aliased objects correctly " &
210
                          "produce Constraint_Error" );
211
  -- start with checks that the Filler assignments produced the expected
212
  -- result.  This is a "case 0" test to check that nothing REALLY surprising
213
  -- is happening
214
 
215
  Check_Array_01_10( Array_Item_01_10, 0 );
216
  Check_Array_11_20( Array_Item_11_20, 10 );
217
 
218
  -- check that having the variable aliased makes no difference
219
  Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
220
  Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
221
 
222
  -- now check that conversion between array types where the only
223
  -- difference in the definitions is that the components are aliased works
224
 
225
  Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
226
  Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
227
 
228
  -- check that conversion of an aliased object with aliased components
229
  -- also works
230
 
231
  Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
232
                     60 );
233
  Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
234
                     70 );
235
 
236
  -- check that the bounds will slide
237
 
238
  Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
239
  Check_Array_11_20( Array_11_20( Array_Item_01_10 ),  0 );
240
 
241
  -- point at some of the components and check them
242
 
243
  An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
244
 
245
  Check_Single_Integer( An_Integer_Access.all, 24,
246
                       "Aliased component 'Access");
247
 
248
  An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
249
 
250
  Check_Single_Integer( An_Integer_Access.all, 66,
251
                       "Aliased Aliased component 'Access");
252
 
253
  -- check some assignments
254
 
255
  Array_Item_01_10 := Aliased_Array_Item_01_10;
256
  Check_Array_01_10( Array_Item_01_10, 40 );
257
 
258
  Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
259
  Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
260
 
261
  Aliased_Array_Aliased_Item_11_20(11..20)
262
                                       := Aliased_Array_Aliased_Item_01_10;
263
  Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
264
                     60 );
265
 
266
  Report.Result;
267
 
268
end C360002;

powered by: WebSVN 2.1.0

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