From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/cxa/cxac001.a | 292 ++++++++++++++++++++++++++++ 1 file changed, 292 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cxa/cxac001.a (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxac001.a') diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxac001.a b/gcc/testsuite/ada/acats/tests/cxa/cxac001.a new file mode 100644 index 000000000..a77d561f5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxa/cxac001.a @@ -0,0 +1,292 @@ +-- 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; -- cgit v1.2.3