| -- 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; |
