|
111
|
1 -- CXA9001.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 the operations defined in the generic package
|
|
|
28 -- Ada.Storage_IO provide the ability to store and retrieve objects
|
|
|
29 -- which may include implicit levels of indirection in their
|
|
|
30 -- implementation, from an in-memory buffer.
|
|
|
31 --
|
|
|
32 -- TEST DESCRIPTION:
|
|
|
33 -- The following scenario demonstrates how an object of a type with
|
|
|
34 -- (potential) levels of indirection (based on the implementation)
|
|
|
35 -- can be "flattened" and written/read to/from a Direct_IO file.
|
|
|
36 -- In this small example, we have attempted to simulate the situation
|
|
|
37 -- where two independent programs are using a particular Direct_IO file,
|
|
|
38 -- one writing data to the file, and the second program reading that file.
|
|
|
39 -- The Storage_IO Read and Write procedures are used to "flatten"
|
|
|
40 -- and reconstruct objects of the record type.
|
|
|
41 --
|
|
|
42 -- APPLICABILITY CRITERIA:
|
|
|
43 -- Applicable to implementations capable of supporting external
|
|
|
44 -- Direct_IO files.
|
|
|
45 --
|
|
|
46 --
|
|
|
47 -- CHANGE HISTORY:
|
|
|
48 -- 06 Dec 94 SAIC ACVC 2.0
|
|
|
49 -- 07 Jun 95 SAIC Modified to constrain type used with Storage_IO.
|
|
|
50 -- 20 Nov 95 SAIC Corrected and enhanced for ACVC 2.0.1.
|
|
|
51 -- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations
|
|
|
52 --!
|
|
|
53
|
|
|
54 with Report;
|
|
|
55 with Ada.Storage_IO;
|
|
|
56 with Ada.Direct_IO;
|
|
|
57
|
|
|
58 procedure CXA9001 is
|
|
|
59 package Dir_IO is new Ada.Direct_IO (Integer);
|
|
|
60 Test_File : Dir_IO.File_Type;
|
|
|
61 Incomplete : exception;
|
|
|
62 begin
|
|
|
63
|
|
|
64 Report.Test ("CXA9001", "Check that the operations defined in the " &
|
|
|
65 "generic package Ada.Storage_IO provide the " &
|
|
|
66 "ability to store and retrieve objects which " &
|
|
|
67 "may include implicit levels of indirection in " &
|
|
|
68 "their implementation, from an in-memory buffer");
|
|
|
69
|
|
|
70
|
|
|
71 Test_For_Direct_IO_Support:
|
|
|
72 begin
|
|
|
73
|
|
|
74 -- The following Create does not have any bearing on the test scenario,
|
|
|
75 -- but is included to check that the implementation supports Direct_IO
|
|
|
76 -- files. An exception on this Create statement will raise a Name_Error
|
|
|
77 -- or Use_Error, which will be handled to produce a Not_Applicable
|
|
|
78 -- result. If created, the file is immediately deleted, as it is not
|
|
|
79 -- needed for the program scenario.
|
|
|
80
|
|
|
81 Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1));
|
|
|
82
|
|
|
83 exception
|
|
|
84
|
|
|
85 when Dir_IO.Use_Error | Dir_IO.Name_Error =>
|
|
|
86 Report.Not_Applicable
|
|
|
87 ( "Files not supported - Create as Out_File for Direct_IO" );
|
|
|
88 raise Incomplete;
|
|
|
89
|
|
|
90 end Test_for_Direct_IO_Support;
|
|
|
91
|
|
|
92 Deletion1:
|
|
|
93 begin
|
|
|
94 Dir_IO.Delete (Test_File);
|
|
|
95 exception
|
|
|
96 when others =>
|
|
|
97 Report.Failed
|
|
|
98 ( "Delete not properly implemented for Direct_IO - 1" );
|
|
|
99 end Deletion1;
|
|
|
100
|
|
|
101
|
|
|
102 Test_Block:
|
|
|
103 declare
|
|
|
104
|
|
|
105 The_Filename : constant String := Report.Legal_File_Name(2);
|
|
|
106
|
|
|
107 -- The following type is the basic unit used in this test. It is
|
|
|
108 -- incorporated into the definition of the Unit_Array_Type.
|
|
|
109
|
|
|
110 type Unit_Type is
|
|
|
111 record
|
|
|
112 Position : Natural := 19;
|
|
|
113 String_Value : String (1..9) := (others => 'X');
|
|
|
114 end record;
|
|
|
115
|
|
|
116 TC_Size : Natural := Natural'First;
|
|
|
117
|
|
|
118 procedure Data_Storage (Number_Of_Units : in Natural;
|
|
|
119 Result : out Natural) is
|
|
|
120
|
|
|
121 -- Type based on input parameter. Uses type Unit_Type
|
|
|
122 -- as the array element.
|
|
|
123 type Unit_Array_Type is array (1..Number_Of_Units)
|
|
|
124 of Unit_Type;
|
|
|
125
|
|
|
126 -- This type definition is the ultimate storage type used
|
|
|
127 -- in this test; uses type Unit_Array_Type as a record
|
|
|
128 -- component field.
|
|
|
129 -- This record type contains a component that is an array of
|
|
|
130 -- records, with each of these records containing a Natural
|
|
|
131 -- and a String value (i.e., a record containing an array of
|
|
|
132 -- records).
|
|
|
133
|
|
|
134 type Data_Storage_Type is
|
|
|
135 record
|
|
|
136 Data_Value : Natural := Number_Of_Units;
|
|
|
137 Unit_Array : Unit_Array_Type;
|
|
|
138 end record;
|
|
|
139
|
|
|
140 -- The instantiation of the following generic package is a
|
|
|
141 -- central point in this test. Storage_IO is instantiated for
|
|
|
142 -- a specific data type, and will be used to "flatten" objects
|
|
|
143 -- of that type into buffers. Direct_IO is instantiated for
|
|
|
144 -- these Storage_IO buffers.
|
|
|
145
|
|
|
146 package Flat_Storage_IO is
|
|
|
147 new Ada.Storage_IO (Data_Storage_Type);
|
|
|
148 package Buffer_IO is
|
|
|
149 new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
|
|
|
150
|
|
|
151 Buffer_File : Buffer_IO.File_Type;
|
|
|
152 Outbound_Buffer : Flat_Storage_IO.Buffer_Type;
|
|
|
153 Storage_Item : Data_Storage_Type;
|
|
|
154
|
|
|
155 begin -- procedure Data_Storage
|
|
|
156
|
|
|
157 Buffer_IO.Create (Buffer_File,
|
|
|
158 Buffer_IO.Out_File,
|
|
|
159 The_Filename);
|
|
|
160
|
|
|
161 Flat_Storage_IO.Write (Buffer => Outbound_Buffer,
|
|
|
162 Item => Storage_Item);
|
|
|
163
|
|
|
164 -- At this point, any levels of indirection have been removed
|
|
|
165 -- by the Storage_IO procedure, and the buffered data can be
|
|
|
166 -- written to a file.
|
|
|
167
|
|
|
168 Buffer_IO.Write (Buffer_File, Outbound_Buffer);
|
|
|
169 Buffer_IO.Close (Buffer_File);
|
|
|
170 Result := Storage_Item.Unit_Array'Last + -- 5 +
|
|
|
171 Storage_Item.Unit_Array -- 9
|
|
|
172 (Storage_Item.Unit_Array'First).String_Value'Length;
|
|
|
173
|
|
|
174 exception
|
|
|
175 when others =>
|
|
|
176 Report.Failed ("Data storage error");
|
|
|
177 if Buffer_IO.Is_Open (Buffer_File) then
|
|
|
178 Buffer_IO.Close (Buffer_File);
|
|
|
179 end if;
|
|
|
180 end Data_Storage;
|
|
|
181
|
|
|
182 procedure Data_Retrieval (Number_Of_Units : in Natural;
|
|
|
183 Result : out Natural) is
|
|
|
184 type Unit_Array_Type is array (1..Number_Of_Units)
|
|
|
185 of Unit_Type;
|
|
|
186
|
|
|
187 type Data_Storage_Type is
|
|
|
188 record
|
|
|
189 Data_Value : Natural := Number_Of_Units;
|
|
|
190 Unit_Array : Unit_Array_Type;
|
|
|
191 end record;
|
|
|
192
|
|
|
193 package Flat_Storage_IO is
|
|
|
194 new Ada.Storage_IO (Data_Storage_Type);
|
|
|
195 package Reader_IO is
|
|
|
196 new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
|
|
|
197
|
|
|
198 Reader_File : Reader_IO.File_Type;
|
|
|
199 Inbound_Buffer : Flat_Storage_IO.Buffer_Type;
|
|
|
200 Storage_Item : Data_Storage_Type;
|
|
|
201 TC_Item : Data_Storage_Type;
|
|
|
202
|
|
|
203 begin -- procedure Data_Retrieval
|
|
|
204
|
|
|
205 Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename);
|
|
|
206 Reader_IO.Read (Reader_File, Inbound_Buffer);
|
|
|
207
|
|
|
208 Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item);
|
|
|
209
|
|
|
210 -- Validate the reconstructed value against an "unflattened"
|
|
|
211 -- value.
|
|
|
212
|
|
|
213 if Storage_Item.Data_Value /= TC_Item.Data_Value
|
|
|
214 then
|
|
|
215 Report.Failed ("Data_Retrieval Error - 1");
|
|
|
216 end if;
|
|
|
217
|
|
|
218 for i in 1..Number_Of_Units loop
|
|
|
219 if Storage_Item.Unit_Array(i).String_Value'Length /=
|
|
|
220 TC_Item.Unit_Array(i).String_Value'Length or
|
|
|
221 Storage_Item.Unit_Array(i).Position /=
|
|
|
222 TC_Item.Unit_Array(i).Position or
|
|
|
223 Storage_Item.Unit_Array(i).String_Value /=
|
|
|
224 TC_Item.Unit_Array(i).String_Value
|
|
|
225 then
|
|
|
226 Report.Failed ("Data_Retrieval Error - 2");
|
|
|
227 end if;
|
|
|
228 end loop;
|
|
|
229
|
|
|
230 Result := Storage_Item.Unit_Array'Last + -- 5 +
|
|
|
231 Storage_Item.Unit_Array -- 9
|
|
|
232 (Storage_Item.Unit_Array'First).String_Value'Length;
|
|
|
233
|
|
|
234 if Reader_IO.Is_Open (Reader_File) then
|
|
|
235 Reader_IO.Delete (Reader_File);
|
|
|
236 else
|
|
|
237 Reader_IO.Open (Reader_File,
|
|
|
238 Reader_IO.In_File,
|
|
|
239 The_Filename);
|
|
|
240 Reader_IO.Delete (Reader_File);
|
|
|
241 end if;
|
|
|
242
|
|
|
243 exception
|
|
|
244 when others =>
|
|
|
245 Report.Failed ("Exception raised in Data_Retrieval");
|
|
|
246 if Reader_IO.Is_Open (Reader_File) then
|
|
|
247 Reader_IO.Delete (Reader_File);
|
|
|
248 else
|
|
|
249 Reader_IO.Open (Reader_File,
|
|
|
250 Reader_IO.In_File,
|
|
|
251 The_Filename);
|
|
|
252 Reader_IO.Delete (Reader_File);
|
|
|
253 end if;
|
|
|
254 end Data_Retrieval;
|
|
|
255
|
|
|
256
|
|
|
257 begin -- Test_Block
|
|
|
258
|
|
|
259 -- The number of Units is provided in this call to Data_Storage.
|
|
|
260 Data_Storage (Number_Of_Units => Natural(Report.Ident_Int(5)),
|
|
|
261 Result => TC_Size);
|
|
|
262
|
|
|
263 if TC_Size /= 14 then
|
|
|
264 Report.Failed ("Data_Storage error in Data_Storage");
|
|
|
265 end if;
|
|
|
266
|
|
|
267 Data_Retrieval (Number_Of_Units => Natural(Report.Ident_Int(5)),
|
|
|
268 Result => TC_Size);
|
|
|
269
|
|
|
270 if TC_Size /= 14 then
|
|
|
271 Report.Failed ("Data retrieval error in Data_Retrieval");
|
|
|
272 end if;
|
|
|
273
|
|
|
274 exception
|
|
|
275 when others => Report.Failed ("Exception raised in Test_Block");
|
|
|
276 end Test_Block;
|
|
|
277
|
|
|
278 Report.Result;
|
|
|
279
|
|
|
280 exception
|
|
|
281 when Incomplete =>
|
|
|
282 Report.Result;
|
|
|
283 when others =>
|
|
|
284 Report.Failed ( "Unexpected exception" );
|
|
|
285 Report.Result;
|
|
|
286
|
|
|
287 end CXA9001;
|
