diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxac001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxa/cxac001.a | 292 |
1 files changed, 0 insertions, 292 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxac001.a b/gcc/testsuite/ada/acats/tests/cxa/cxac001.a deleted file mode 100644 index a77d561f5d6..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxac001.a +++ /dev/null @@ -1,292 +0,0 @@ --- 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; |