gcc/testsuite/ada/acats/tests/cxa/cxa9001.a

   1 -- CXA9001.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that the operations defined in the generic package
  28 --      Ada.Storage_IO provide the ability to store and retrieve objects
  29 --      which may include implicit levels of indirection in their
  30 --      implementation, from an in-memory buffer.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      The following scenario demonstrates how an object of a type with
  34 --      (potential) levels of indirection (based on the implementation)
  35 --      can be "flattened" and written/read to/from a Direct_IO file.
  36 --      In this small example, we have attempted to simulate the situation
  37 --      where two independent programs are using a particular Direct_IO file,
  38 --      one writing data to the file, and the second program reading that file.
  39 --      The Storage_IO Read and Write procedures are used to "flatten"
  40 --      and reconstruct objects of the record type.
  41 --
  42 -- APPLICABILITY CRITERIA:
  43 --      Applicable to implementations capable of supporting external
  44 --      Direct_IO files.
  45 --
  46 --
  47 -- CHANGE HISTORY:
  48 --      06 Dec 94   SAIC    ACVC 2.0
  49 --      07 Jun 95   SAIC    Modified to constrain type used with Storage_IO.
  50 --      20 Nov 95   SAIC    Corrected and enhanced for ACVC 2.0.1.
  51 --      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
  52 --!
  53
  54 with Report;
  55 with Ada.Storage_IO;
  56 with Ada.Direct_IO;
  57
  58 procedure CXA9001 is
  59    package Dir_IO is new Ada.Direct_IO (Integer);
  60    Test_File  : Dir_IO.File_Type;
  61    Incomplete : exception;
  62 begin
  63
  64    Report.Test ("CXA9001", "Check that the operations defined in the "      &
  65                            "generic package Ada.Storage_IO provide the "    &
  66                            "ability to store and retrieve objects which "   &
  67                            "may include implicit levels of indirection in " &
  68                            "their implementation, from an in-memory buffer");
  69
  70
  71    Test_For_Direct_IO_Support:
  72    begin
  73
  74       -- The following Create does not have any bearing on the test scenario,
  75       -- but is included to check that the implementation supports Direct_IO
  76       -- files.  An exception on this Create statement will raise a Name_Error
  77       -- or Use_Error, which will be handled to produce a Not_Applicable
  78       -- result. If created, the file is immediately deleted, as it is not
  79       -- needed for the program scenario.
  80
  81       Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1));
  82
  83    exception
  84
  85        when Dir_IO.Use_Error | Dir_IO.Name_Error =>
  86           Report.Not_Applicable
  87              ( "Files not supported - Create as Out_File for Direct_IO" );
  88           raise Incomplete;
  89
  90    end Test_for_Direct_IO_Support;
  91
  92    Deletion1:
  93    begin
  94       Dir_IO.Delete (Test_File);
  95    exception
  96       when others =>
  97          Report.Failed
  98             ( "Delete not properly implemented for Direct_IO - 1" );
  99    end Deletion1;
 100
 101
 102    Test_Block:
 103    declare
 104
 105       The_Filename : constant String := Report.Legal_File_Name(2);
 106
 107       -- The following type is the basic unit used in this test. It is
 108       -- incorporated into the definition of the Unit_Array_Type.
 109
 110       type Unit_Type is
 111          record
 112             Position     : Natural := 19;
 113             String_Value : String (1..9) := (others => 'X');
 114          end record;
 115
 116       TC_Size : Natural := Natural'First;
 117
 118       procedure Data_Storage (Number_Of_Units  : in     Natural;
 119                               Result           :    out Natural) is
 120
 121          -- Type based on input parameter.  Uses type Unit_Type
 122          -- as the array element.
 123          type Unit_Array_Type is array (1..Number_Of_Units)
 124            of Unit_Type;
 125
 126          -- This type definition is the ultimate storage type used
 127          -- in this test; uses type Unit_Array_Type as a record
 128          -- component field.
 129          -- This record type contains a component that is an array of
 130          -- records, with each of these records containing a Natural
 131          -- and a String value (i.e., a record containing an array of
 132          -- records).
 133
 134          type Data_Storage_Type is
 135             record
 136                Data_Value : Natural := Number_Of_Units;
 137                Unit_Array : Unit_Array_Type;
 138             end record;
 139
 140          -- The instantiation of the following generic package is a
 141          -- central point in this test.  Storage_IO is instantiated for
 142          -- a specific data type, and will be used to "flatten" objects
 143          -- of that type into buffers.  Direct_IO is instantiated for
 144          -- these Storage_IO buffers.
 145
 146          package Flat_Storage_IO is
 147            new Ada.Storage_IO (Data_Storage_Type);
 148          package Buffer_IO is
 149            new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
 150
 151          Buffer_File      : Buffer_IO.File_Type;
 152          Outbound_Buffer  : Flat_Storage_IO.Buffer_Type;
 153          Storage_Item     : Data_Storage_Type;
 154
 155       begin  -- procedure Data_Storage
 156
 157          Buffer_IO.Create (Buffer_File,
 158                            Buffer_IO.Out_File,
 159                            The_Filename);
 160
 161          Flat_Storage_IO.Write (Buffer => Outbound_Buffer,
 162                                 Item   => Storage_Item);
 163
 164          -- At this point, any levels of indirection have been removed
 165          -- by the Storage_IO procedure, and the buffered data can be
 166          -- written to a file.
 167
 168          Buffer_IO.Write (Buffer_File, Outbound_Buffer);
 169          Buffer_IO.Close (Buffer_File);
 170          Result := Storage_Item.Unit_Array'Last +           -- 5 +
 171                    Storage_Item.Unit_Array                  -- 9
 172                      (Storage_Item.Unit_Array'First).String_Value'Length;
 173
 174       exception
 175          when others =>
 176             Report.Failed ("Data storage error");
 177             if Buffer_IO.Is_Open (Buffer_File) then
 178                Buffer_IO.Close (Buffer_File);
 179             end if;
 180       end Data_Storage;
 181
 182       procedure Data_Retrieval (Number_Of_Units  : in     Natural;
 183                                 Result           :    out Natural) is
 184          type Unit_Array_Type is array (1..Number_Of_Units)
 185            of Unit_Type;
 186
 187          type Data_Storage_Type is
 188             record
 189                Data_Value : Natural := Number_Of_Units;
 190                Unit_Array : Unit_Array_Type;
 191             end record;
 192
 193          package Flat_Storage_IO is
 194            new Ada.Storage_IO (Data_Storage_Type);
 195          package Reader_IO is
 196            new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
 197
 198          Reader_File      : Reader_IO.File_Type;
 199          Inbound_Buffer   : Flat_Storage_IO.Buffer_Type;
 200          Storage_Item     : Data_Storage_Type;
 201          TC_Item          : Data_Storage_Type;
 202
 203       begin  -- procedure Data_Retrieval
 204
 205          Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename);
 206          Reader_IO.Read (Reader_File, Inbound_Buffer);
 207
 208          Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item);
 209
 210          -- Validate the reconstructed value against an "unflattened"
 211          -- value.
 212
 213          if Storage_Item.Data_Value /= TC_Item.Data_Value
 214          then
 215             Report.Failed ("Data_Retrieval Error - 1");
 216          end if;
 217
 218          for i in 1..Number_Of_Units loop
 219             if Storage_Item.Unit_Array(i).String_Value'Length  /=
 220                TC_Item.Unit_Array(i).String_Value'Length      or
 221                Storage_Item.Unit_Array(i).Position     /=
 222                TC_Item.Unit_Array(i).Position             or
 223                Storage_Item.Unit_Array(i).String_Value /=
 224                TC_Item.Unit_Array(i).String_Value
 225             then
 226                Report.Failed ("Data_Retrieval Error - 2");
 227             end if;
 228          end loop;
 229
 230          Result := Storage_Item.Unit_Array'Last +           -- 5 +
 231                    Storage_Item.Unit_Array                  -- 9
 232                      (Storage_Item.Unit_Array'First).String_Value'Length;
 233
 234          if Reader_IO.Is_Open (Reader_File) then
 235             Reader_IO.Delete (Reader_File);
 236          else
 237             Reader_IO.Open (Reader_File,
 238                             Reader_IO.In_File,
 239                             The_Filename);
 240             Reader_IO.Delete (Reader_File);
 241          end if;
 242
 243       exception
 244          when others =>
 245             Report.Failed ("Exception raised in Data_Retrieval");
 246             if Reader_IO.Is_Open (Reader_File) then
 247                Reader_IO.Delete (Reader_File);
 248             else
 249                Reader_IO.Open (Reader_File,
 250                                Reader_IO.In_File,
 251                                The_Filename);
 252                Reader_IO.Delete (Reader_File);
 253             end if;
 254       end Data_Retrieval;
 255
 256
 257    begin  -- Test_Block
 258
 259       -- The number of Units is provided in this call to Data_Storage.
 260       Data_Storage (Number_Of_Units  => Natural(Report.Ident_Int(5)),
 261                     Result           => TC_Size);
 262
 263       if TC_Size /= 14 then
 264          Report.Failed ("Data_Storage error in Data_Storage");
 265       end if;
 266
 267       Data_Retrieval (Number_Of_Units  => Natural(Report.Ident_Int(5)),
 268                       Result           => TC_Size);
 269
 270       if TC_Size /= 14 then
 271          Report.Failed ("Data retrieval error in Data_Retrieval");
 272       end if;
 273
 274    exception
 275       when others => Report.Failed ("Exception raised in Test_Block");
 276    end Test_Block;
 277
 278    Report.Result;
 279
 280 exception
 281    when Incomplete =>
 282       Report.Result;
 283    when others     =>
 284       Report.Failed ( "Unexpected exception" );
 285       Report.Result;
 286
 287 end CXA9001;