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 54with Report; 55with Ada.Storage_IO; 56with Ada.Direct_IO; 57 58procedure CXA9001 is 59 package Dir_IO is new Ada.Direct_IO (Integer); 60 Test_File : Dir_IO.File_Type; 61 Incomplete : exception; 62begin 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 280exception 281 when Incomplete => 282 Report.Result; 283 when others => 284 Report.Failed ( "Unexpected exception" ); 285 Report.Result; 286 287end CXA9001; 288