Subversion Repositories openrisc

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