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
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
-- CXA9001.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 the operations defined in the generic package
-- Ada.Storage_IO provide the ability to store and retrieve objects
-- which may include implicit levels of indirection in their
-- implementation, from an in-memory buffer.
--
-- TEST DESCRIPTION:
-- The following scenario demonstrates how an object of a type with
-- (potential) levels of indirection (based on the implementation)
-- can be "flattened" and written/read to/from a Direct_IO file.
-- In this small example, we have attempted to simulate the situation
-- where two independent programs are using a particular Direct_IO file,
-- one writing data to the file, and the second program reading that file.
-- The Storage_IO Read and Write procedures are used to "flatten"
-- and reconstruct objects of the record type.
--
-- APPLICABILITY CRITERIA:
-- Applicable to implementations capable of supporting external
-- Direct_IO files.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 07 Jun 95 SAIC Modified to constrain type used with Storage_IO.
-- 20 Nov 95 SAIC Corrected and enhanced for ACVC 2.0.1.
-- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations
--!
with Report;
with Ada.Storage_IO;
with Ada.Direct_IO;
procedure CXA9001 is
package Dir_IO is new Ada.Direct_IO (Integer);
Test_File : Dir_IO.File_Type;
Incomplete : exception;
begin
Report.Test ("CXA9001", "Check that the operations defined in the " &
"generic package Ada.Storage_IO provide the " &
"ability to store and retrieve objects which " &
"may include implicit levels of indirection in " &
"their implementation, from an in-memory buffer");
Test_For_Direct_IO_Support:
begin
-- The following Create does not have any bearing on the test scenario,
-- but is included to check that the implementation supports Direct_IO
-- files. An exception on this Create statement will raise a Name_Error
-- or Use_Error, which will be handled to produce a Not_Applicable
-- result. If created, the file is immediately deleted, as it is not
-- needed for the program scenario.
Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1));
exception
when Dir_IO.Use_Error | Dir_IO.Name_Error =>
Report.Not_Applicable
( "Files not supported - Create as Out_File for Direct_IO" );
raise Incomplete;
end Test_for_Direct_IO_Support;
Deletion1:
begin
Dir_IO.Delete (Test_File);
exception
when others =>
Report.Failed
( "Delete not properly implemented for Direct_IO - 1" );
end Deletion1;
Test_Block:
declare
The_Filename : constant String := Report.Legal_File_Name(2);
-- The following type is the basic unit used in this test. It is
-- incorporated into the definition of the Unit_Array_Type.
type Unit_Type is
record
Position : Natural := 19;
String_Value : String (1..9) := (others => 'X');
end record;
TC_Size : Natural := Natural'First;
procedure Data_Storage (Number_Of_Units : in Natural;
Result : out Natural) is
-- Type based on input parameter. Uses type Unit_Type
-- as the array element.
type Unit_Array_Type is array (1..Number_Of_Units)
of Unit_Type;
-- This type definition is the ultimate storage type used
-- in this test; uses type Unit_Array_Type as a record
-- component field.
-- This record type contains a component that is an array of
-- records, with each of these records containing a Natural
-- and a String value (i.e., a record containing an array of
-- records).
type Data_Storage_Type is
record
Data_Value : Natural := Number_Of_Units;
Unit_Array : Unit_Array_Type;
end record;
-- The instantiation of the following generic package is a
-- central point in this test. Storage_IO is instantiated for
-- a specific data type, and will be used to "flatten" objects
-- of that type into buffers. Direct_IO is instantiated for
-- these Storage_IO buffers.
package Flat_Storage_IO is
new Ada.Storage_IO (Data_Storage_Type);
package Buffer_IO is
new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
Buffer_File : Buffer_IO.File_Type;
Outbound_Buffer : Flat_Storage_IO.Buffer_Type;
Storage_Item : Data_Storage_Type;
begin -- procedure Data_Storage
Buffer_IO.Create (Buffer_File,
Buffer_IO.Out_File,
The_Filename);
Flat_Storage_IO.Write (Buffer => Outbound_Buffer,
Item => Storage_Item);
-- At this point, any levels of indirection have been removed
-- by the Storage_IO procedure, and the buffered data can be
-- written to a file.
Buffer_IO.Write (Buffer_File, Outbound_Buffer);
Buffer_IO.Close (Buffer_File);
Result := Storage_Item.Unit_Array'Last + -- 5 +
Storage_Item.Unit_Array -- 9
(Storage_Item.Unit_Array'First).String_Value'Length;
exception
when others =>
Report.Failed ("Data storage error");
if Buffer_IO.Is_Open (Buffer_File) then
Buffer_IO.Close (Buffer_File);
end if;
end Data_Storage;
procedure Data_Retrieval (Number_Of_Units : in Natural;
Result : out Natural) is
type Unit_Array_Type is array (1..Number_Of_Units)
of Unit_Type;
type Data_Storage_Type is
record
Data_Value : Natural := Number_Of_Units;
Unit_Array : Unit_Array_Type;
end record;
package Flat_Storage_IO is
new Ada.Storage_IO (Data_Storage_Type);
package Reader_IO is
new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
Reader_File : Reader_IO.File_Type;
Inbound_Buffer : Flat_Storage_IO.Buffer_Type;
Storage_Item : Data_Storage_Type;
TC_Item : Data_Storage_Type;
begin -- procedure Data_Retrieval
Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename);
Reader_IO.Read (Reader_File, Inbound_Buffer);
Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item);
-- Validate the reconstructed value against an "unflattened"
-- value.
if Storage_Item.Data_Value /= TC_Item.Data_Value
then
Report.Failed ("Data_Retrieval Error - 1");
end if;
for i in 1..Number_Of_Units loop
if Storage_Item.Unit_Array(i).String_Value'Length /=
TC_Item.Unit_Array(i).String_Value'Length or
Storage_Item.Unit_Array(i).Position /=
TC_Item.Unit_Array(i).Position or
Storage_Item.Unit_Array(i).String_Value /=
TC_Item.Unit_Array(i).String_Value
then
Report.Failed ("Data_Retrieval Error - 2");
end if;
end loop;
Result := Storage_Item.Unit_Array'Last + -- 5 +
Storage_Item.Unit_Array -- 9
(Storage_Item.Unit_Array'First).String_Value'Length;
if Reader_IO.Is_Open (Reader_File) then
Reader_IO.Delete (Reader_File);
else
Reader_IO.Open (Reader_File,
Reader_IO.In_File,
The_Filename);
Reader_IO.Delete (Reader_File);
end if;
exception
when others =>
Report.Failed ("Exception raised in Data_Retrieval");
if Reader_IO.Is_Open (Reader_File) then
Reader_IO.Delete (Reader_File);
else
Reader_IO.Open (Reader_File,
Reader_IO.In_File,
The_Filename);
Reader_IO.Delete (Reader_File);
end if;
end Data_Retrieval;
begin -- Test_Block
-- The number of Units is provided in this call to Data_Storage.
Data_Storage (Number_Of_Units => Natural(Report.Ident_Int(5)),
Result => TC_Size);
if TC_Size /= 14 then
Report.Failed ("Data_Storage error in Data_Storage");
end if;
Data_Retrieval (Number_Of_Units => Natural(Report.Ident_Int(5)),
Result => TC_Size);
if TC_Size /= 14 then
Report.Failed ("Data retrieval error in Data_Retrieval");
end if;
exception
when others => Report.Failed ("Exception raised in Test_Block");
end Test_Block;
Report.Result;
exception
when Incomplete =>
Report.Result;
when others =>
Report.Failed ( "Unexpected exception" );
Report.Result;
end CXA9001;
|
