path: root/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a

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