obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

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.

1 files changed, 287 insertions, 0 deletions

diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a b/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a
new file mode 100644
index 000000000..4fe9c3576
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a
@@ -0,0 +1,287 @@
+-- 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;