-- CXAC001.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 attribute T'Write will, for any specific non-limited -- type T, write an item of the subtype to the stream. -- -- Check that the attribute T'Read will, for a specific non-limited -- type T, read a value of the subtype from the stream. -- -- TEST DESCRIPTION: -- The scenario depicted in this test is that of an environment where -- product data is stored in stream form, then reconstructed into the -- appropriate data structures. Several records of product information -- are stored in an array; the array is passed as a parameter to a -- procedure for storage in the stream. A header is created based on the -- number of data records stored in the array. The header is then written -- to the stream, followed by each record maintained in the array. -- In order to retrieve data from the stream, the header information is -- read from the stream, and the data stored in the header is used to -- perform the appropriate number of read operations of record data from -- the stream. All data read from the stream is validated against the --- values that were written to the stream. -- -- APPLICABILITY CRITERIA: -- Applicable to all systems capable of supporting IO operations on -- external Stream_IO files. -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- 08 Nov 95 SAIC Corrected call to Read in Procedure Retrieve_Data -- for ACVC 2.0.1. -- 27 Feb 08 PWB.CTA Allowed for non-support of certain IO operations. --! with Ada.Streams.Stream_IO; with Report; procedure CXAC001 is package Strm_Pack renames Ada.Streams.Stream_IO; The_File : Strm_Pack.File_Type; The_Filename : constant String := Report.Legal_File_Name ( Nam => "CXAC001" ); Incomplete : exception; begin Report.Test ("CXAC001", "Check that the 'Read and 'Write attributes " & "will transfer an object of a specific, " & "non-limited type to/from a stream"); Test_for_Stream_IO_Support: begin -- If an implementation does not support Stream_IO in a particular -- environment, the exception Use_Error or Name_Error will be raised on -- calls to various Stream_IO operations. This block statement -- encloses a call to Create, which should produce an exception in a -- non-supportive environment. These exceptions will be handled to -- produce a Not_Applicable result. Strm_Pack.Create (The_File, Strm_Pack.Out_File, The_Filename); exception when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error => Report.Not_Applicable ( "Files not supported - Create as Out_File for Stream_IO" ); raise Incomplete; end Test_for_Stream_IO_Support; Operational_Test_Block: declare The_Stream : Strm_Pack.Stream_Access; Todays_Date : String (1 .. 6) := "271193"; type ID_Type is range 1 .. 100; type Size_Type is (Small, Medium, Large, XLarge); type Header_Type is record Number_of_Elements : Natural := 0; Origination_Date : String (1 .. 6); end record; type Data_Type is record ID : ID_Type; Size : Size_Type; end record; type Data_Array_Type is array (Positive range <>) of Data_Type; Product_Information_1 : Data_Array_Type (1 .. 3) := ((20, Large), (55, Small), (89, XLarge)); Product_Information_2 : Data_Array_Type (1 .. 4) := (( 5, XLarge), (27, Small), (79, Medium), (93, XLarge)); procedure Store_Data ( The_Stream : in Strm_Pack.Stream_Access; The_Array : in Data_Array_Type ) is Header : Header_Type; begin -- Fill in header info. Header.Number_of_Elements := The_Array'Length; Header.Origination_Date := Todays_Date; -- Write header to stream. Header_Type'Write (The_Stream, Header); -- Write each record in the array to the stream. for I in 1 .. Header.Number_of_Elements loop Data_Type'Write (The_Stream, The_Array (I)); end loop; end Store_Data; procedure Retrieve_Data (The_Stream : in Strm_Pack.Stream_Access; The_Header : out Header_Type; The_Array : out Data_Array_Type ) is begin -- Read header from the stream. Header_Type'Read (The_Stream, The_Header); -- Read the records from the stream into the array. for I in 1 .. The_Header.Number_of_Elements loop Data_Type'Read (The_Stream, The_Array (I)); end loop; end Retrieve_Data; begin -- Assign access value. The_Stream := Strm_Pack.Stream (The_File); -- Product information is to be stored in the stream file. These -- data arrays are of different sizes (actually, the records -- are stored individually, not as a single array). Prior to the -- record data being written, a header record is initialized with -- information about the data to be written, then itself is written -- to the stream. Store_Data (The_Stream, Product_Information_1); Store_Data (The_Stream, Product_Information_2); Test_Verification_Block: declare Product_Header_1 : Header_Type; Product_Header_2 : Header_Type; Product_Array_1 : Data_Array_Type (1 .. 3); Product_Array_2 : Data_Array_Type (1 .. 4); begin Reset1: begin Strm_Pack.Reset (The_File, Strm_Pack.In_File); exception when Ada.Streams.Stream_IO.Use_Error => Report.Not_Applicable ( "Reset to In_File not supported for Stream_IO" ); raise Incomplete; end Reset1; -- Data is read from the stream, first the appropriate header, -- then the associated data records, which are then reconstructed -- into a data array of product information. Retrieve_Data (The_Stream, Product_Header_1, Product_Array_1); -- Validate a field in the header. if (Product_Header_1.Origination_Date /= Todays_Date) or (Product_Header_1.Number_of_Elements /= 3) then Report.Failed ("Incorrect Header_1 info read from stream"); end if; -- Validate the data records read from the file. for I in 1 .. Product_Header_1.Number_of_Elements loop if (Product_Array_1(I) /= Product_Information_1(I)) then Report.Failed ("Incorrect Product 1 info read from" & " record: " & Integer'Image (I)); end if; end loop; -- Repeat this read and verify operation for the next parcel of -- data. Again, header and data record information are read from -- the same stream file. Retrieve_Data (The_Stream, Product_Header_2, Product_Array_2); if (Product_Header_2.Origination_Date /= Todays_Date) or (Product_Header_2.Number_of_Elements /= 4) then Report.Failed ("Incorrect Header_2 info read from stream"); end if; for I in 1 .. Product_Header_2.Number_of_Elements loop if (Product_Array_2(I) /= Product_Information_2(I)) then Report.Failed ("Incorrect Product_2 info read from" & " record: " & Integer'Image (I)); end if; end loop; exception when Incomplete => raise; when Strm_Pack.End_Error => -- If correct number of -- items not in file (data -- overwritten), then fail. Report.Failed ("Incorrect number of record elements in file"); if not Strm_Pack.Is_Open (The_File) then Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename); end if; when others => Report.Failed ("Exception raised in Data Verification Block"); if not Strm_Pack.Is_Open (The_File) then Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename); end if; end Test_Verification_Block; exception when Incomplete => raise; when others => Report.Failed ("Exception raised in Operational Test Block"); end Operational_Test_Block; Deletion: begin -- Delete the file. if Strm_Pack.Is_Open (The_File) then Strm_Pack.Delete (The_File); else Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename); Strm_Pack.Delete (The_File); end if; exception when others => Report.Failed ( "Delete not properly implemented for Stream_IO" ); end Deletion; Report.Result; exception when Incomplete => Report.Result; when others => Report.Failed ( "Unexpected exception" ); Report.Result; end CXAC001;