1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
|
-- C360002.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that modular types may be used as array indices.
--
-- Check that if aliased appears in the component_definition of an
-- array_type that each component of the array is aliased.
--
-- Check that references to aliased array objects produce correct
-- results, and that out-of-bounds indexing correctly produces
-- Constraint_Error.
--
-- TEST DESCRIPTION:
-- This test defines several array types and subtypes indexed by modular
-- types; some aliased some not, some with aliased components, some not.
--
-- It then checks that assignments move the correct data.
--
--
-- CHANGE HISTORY:
-- 28 SEP 95 SAIC Initial version
-- 23 APR 96 SAIC Doc fixes, fixed constrained/unconstrained conflict
-- 13 FEB 97 PWB.CTA Removed illegal declarations and affected code
--!
------------------------------------------------------------------- C360002
with Report;
procedure C360002 is
Verbose : Boolean := Report.Ident_Bool( False );
type Mod_128 is mod 128;
function Ident_128( I: Integer ) return Mod_128 is
begin
return Mod_128( Report.Ident_Int( I ) );
end Ident_128;
type Unconstrained_Array
is array( Mod_128 range <> ) of Integer;
type Unconstrained_Array_Aliased
is array( Mod_128 range <> ) of aliased Integer;
type Access_All_Unconstrained_Array
is access all Unconstrained_Array;
type Access_All_Unconstrained_Array_Aliased
is access all Unconstrained_Array_Aliased;
subtype Array_01_10
is Unconstrained_Array(01..10);
subtype Array_11_20
is Unconstrained_Array(11..20);
subtype Array_Aliased_01_10
is Unconstrained_Array_Aliased(01..10);
subtype Array_Aliased_11_20
is Unconstrained_Array_Aliased(11..20);
subtype Access_All_01_10_Array
is Access_All_Unconstrained_Array(01..10);
subtype Access_All_01_10_Array_Aliased
is Access_All_Unconstrained_Array_Aliased(01..10);
subtype Access_All_11_20_Array
is Access_All_Unconstrained_Array(11..20);
subtype Access_All_11_20_Array_Aliased
is Access_All_Unconstrained_Array_Aliased(11..20);
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- these 'filler' functions create unique values for every element that
-- is used and/or tested in this test.
Well_Bottom : Integer := 0;
function Filler( Size : Mod_128 ) return Unconstrained_Array is
It : Unconstrained_Array( 0..Size-1 );
begin
for Eyes in It'Range loop
It(Eyes) := Integer( Eyes ) + Well_Bottom;
end loop;
Well_Bottom := Well_Bottom + It'Length;
return It;
end Filler;
function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
It : Unconstrained_Array_Aliased( 0..Size-1 );
begin
for Ayes in It'Range loop
It(Ayes) := Integer( Ayes ) + Well_Bottom;
end loop;
Well_Bottom := Well_Bottom + It'Length;
return It;
end Filler;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
An_Integer : Integer;
type AAI is access all Integer;
An_Integer_Access : AAI;
Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
:= Filler(10); -- 60..69
Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
:= Filler(10); -- 70..79
Check_Item : Access_All_Unconstrained_Array;
Check_Aliased_Item : Access_All_Unconstrained_Array_Aliased;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Fail( Message : String; CI, SB : Integer ) is
begin
Report.Failed("Wrong value passed " & Message);
if Verbose then
Report.Comment("got" & Integer'Image(CI) &
" should be" & Integer'Image(SB) );
end if;
end Fail;
procedure Check_Array_01_10( Checked_Item : Array_01_10;
Low_SB : Integer ) is
begin
for Index in Checked_Item'Range loop
if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
Fail("unaliased 1..10", Checked_Item(Index),
(Low_SB +Integer(Index)-1));
end if;
end loop;
end Check_Array_01_10;
procedure Check_Array_11_20( Checked_Item : Array_11_20;
Low_SB : Integer ) is
begin
for Index in Checked_Item'Range loop
if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
Fail("unaliased 11..20", Checked_Item(Index),
(Low_SB +Integer(Index)-11));
end if;
end loop;
end Check_Array_11_20;
procedure Check_Single_Integer( The_Integer, SB : Integer;
Message : String ) is
begin
if The_Integer /= SB then
Report.Failed("Wrong integer value for " & Message );
end if;
end Check_Single_Integer;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
begin -- Main test procedure.
Report.Test ("C360002", "Check that modular types may be used as array " &
"indices. Check that if aliased appears in " &
"the component_definition of an array_type that " &
"each component of the array is aliased. Check " &
"that references to aliased array objects " &
"produce correct results, and that out of bound " &
"references to aliased objects correctly " &
"produce Constraint_Error" );
-- start with checks that the Filler assignments produced the expected
-- result. This is a "case 0" test to check that nothing REALLY surprising
-- is happening
Check_Array_01_10( Array_Item_01_10, 0 );
Check_Array_11_20( Array_Item_11_20, 10 );
-- check that having the variable aliased makes no difference
Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
-- now check that conversion between array types where the only
-- difference in the definitions is that the components are aliased works
Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
-- check that conversion of an aliased object with aliased components
-- also works
Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
60 );
Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
70 );
-- check that the bounds will slide
Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
Check_Array_11_20( Array_11_20( Array_Item_01_10 ), 0 );
-- point at some of the components and check them
An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
Check_Single_Integer( An_Integer_Access.all, 24,
"Aliased component 'Access");
An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
Check_Single_Integer( An_Integer_Access.all, 66,
"Aliased Aliased component 'Access");
-- check some assignments
Array_Item_01_10 := Aliased_Array_Item_01_10;
Check_Array_01_10( Array_Item_01_10, 40 );
Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
Aliased_Array_Aliased_Item_11_20(11..20)
:= Aliased_Array_Aliased_Item_01_10;
Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
60 );
Report.Result;
end C360002;
|
