Subversion Repositories openrisc

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