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, 392 insertions, 0 deletions

diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a b/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
new file mode 100644
index 000000000..3771f6e68
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
@@ -0,0 +1,392 @@
+-- CXB3012.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 Procedure Update modifies the value pointed to by
+--      the chars_ptr parameter Item, starting at the position
+--      corresponding to parameter Offset, using the chars in
+--      char_array parameter Chars.
+--
+--      Check that the version of Procedure Update with a String parameter
+--      behaves in the manner described above, but with the character
+--      values in the String overwriting the char values in Item.
+--
+--      Check that both of the above versions of Procedure Update will
+--      propagate Update_Error if Check is True, and if the length of
+--      the new chars in Chars, when overlaid starting from position
+--      Offset, will overwrite the first nul in Item.
+--
+-- TEST DESCRIPTION:
+--      This test checks two versions of Procedure Update.  In the first
+--      version of the procedure, the parameter Chars indicates a char_array
+--      argument.  These char_array parameters are provided through the use
+--      of the To_C function (with String IN parameter), both with and
+--      without a terminating nul.  In the case below where a terminating nul
+--      char is appended, the effect of "updating" the value pointed to by the
+--      Item parameter will include its shortening, due to the insertion of
+--      this additional nul in the middle of the char_array.
+--
+--      In the second version of Procedure Update evaluated here, the string
+--      parameter Str is used to modify the char_array pointed to by Item.
+--
+--      Finally, both versions of the procedure are evaluated to ensure that
+--      they propagate Update_Error and Dereference_Error under the proper
+--      conditions.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '-' and '.'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.Strings.  If an implementation provides
+--      package Interfaces.C.Strings, this test must compile, execute,
+--      and report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      05 Oct 95   SAIC    Initial prerelease version.
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--      14 Sep 99   RLB     Removed incorrect and unnecessary
+--                          Unchecked_Conversion. Added check for raising
+--                          of Dereference_Error for Update (From Technical
+--                          Corrigendum 1).
+--      07 Jan 05   RLB     Modified to reflect change to Update by AI-242
+--                          (which is expected to be part of Amendment 1).
+--                          [This version allows either semantics.]
+
+--!
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+
+procedure CXB3012 is
+begin
+
+   Report.Test ("CXB3012", "Check that both versions of Procedure Update " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      package IC  renames Interfaces.C;
+      package ICS renames Interfaces.C.Strings;
+      use Ada.Exceptions;
+
+      use type IC.char;
+      use type IC.char_array;
+      use type IC.size_t;
+      use type ICS.chars_ptr;
+
+      TC_String_1        : String(1..1)    := "J";
+      TC_String_2        : String(1..2)    := "Ab";
+      TC_String_3        : String(1..3)    := "xyz";
+      TC_String_4        : String(1..4)    := "ACVC";
+      TC_String_5        : String(1..5)    := "1a2b3";
+      TC_String_6        : String(1..6)    := "---...";
+      TC_String_7        : String(1..7)    := "AABBBAA";
+      TC_String_8        : String(1..8)    := "aBcDeFgH";
+      TC_String_9        : String(1..9)    := "JustATest";
+      TC_String_10       : String(1..10)   := "0123456789";
+
+      TC_Result_String_1 : constant String := "JXXXXXXXXX";
+      TC_Result_String_2 : constant String := "XXXXXXXXAb";
+      TC_Result_String_3 : constant String := "XXXxyz";
+      TC_Result_String_4 : constant String := "XACVC";
+      TC_Result_String_5 : constant String := "1a2b3";
+      TC_Result_String_6 : constant String := "XXX---...";
+
+      TC_Amd_Result_String_4 :
+                           constant String := "XACVCXXXXX";
+      TC_Amd_Result_String_5 :
+                           constant String := "1a2b3XXXXX";
+      TC_Amd_Result_String_6 :
+                           constant String := "XXX---...X";
+      TC_Amd_Result_String_9 :
+                           constant String := "JustATestX";
+
+      TC_char_array        : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
+      TC_Result_char_array : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
+      TC_chars_ptr         : ICS.chars_ptr;
+      TC_Length            : IC.size_t;
+
+   begin
+
+      -- Check that Procedure Update modifies the value pointed to by
+      -- the chars_ptr parameter Item, starting at the position
+      -- corresponding to parameter Offset, using the chars in
+      -- char_array parameter Chars.
+      -- Note: If parameter Chars contains a nul char (such as a
+      --       terminating nul), the result may be the overall shortening
+      --       of parameter Item.
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+
+      ICS.Update(Item   => TC_chars_ptr,
+                 Offset => 0,
+                 Chars  => IC.To_C(TC_String_1, False),  -- No nul char.
+                 Check  => True);
+
+      if ICS.Value(TC_chars_ptr) /= TC_Result_String_1 then
+         Report.Failed("Incorrect result from Procedure Update - 1");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr,
+                 Offset => ICS.Strlen(TC_chars_ptr) - 2,
+                 Chars  => IC.To_C(TC_String_2, False),  -- No nul char.
+                 Check  => True);
+
+      if ICS.Value(TC_chars_ptr) /= TC_Result_String_2 then
+         Report.Failed("Incorrect result from Procedure Update - 2");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr,
+                 3,
+                 Chars  => IC.To_C(TC_String_3),   -- Nul appended, shortens
+                 Check  => False);                 -- array.
+
+      if ICS.Value(TC_chars_ptr) /= TC_Result_String_3 then
+         Report.Failed("Incorrect result from Procedure Update - 3");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr,
+                 0,
+                 IC.To_C(TC_String_10), -- Complete replacement of array.
+                 Check  => False);
+
+      if ICS.Value(TC_chars_ptr) /= TC_String_10 then
+         Report.Failed("Incorrect result from Procedure Update - 4");
+      end if;
+
+      -- Perform a character-by-character comparison of the result of
+      -- Procedure Update. Note that char_array lower bound is 0, and
+      -- that the nul char is not compared with any character in the
+      -- string (since the string is not nul terminated).
+      begin
+         TC_Length := ICS.Strlen(TC_chars_ptr);
+         TC_Result_char_array(0..10) := ICS.Value(TC_chars_ptr);
+         for i in 0..TC_Length-1 loop
+            if TC_Result_char_array(i) /=
+               IC.To_C(TC_String_10(Integer(i+1)))
+            then
+               Report.Failed("Incorrect result from the character-by-" &
+                             "character evaluation of the result of "  &
+                             "Procedure Update");
+            end if;
+         end loop;
+      exception
+         when others =>
+           Report.Failed("Exception raised during the character-by-" &
+                         "character evaluation of the result of "    &
+                         "Procedure Update");
+      end;
+      ICS.Free(TC_chars_ptr);
+
+
+
+      -- Check that the version of Procedure Update with a String rather
+      -- than a char_array parameter behaves in the manner described above,
+      -- but with the character values in the String overwriting the char
+      -- values in Item.
+      --
+      -- Note: In Ada 95, In each of the cases below, the String parameter
+      --       Str is treated as if it were nul terminated, which means that
+      --       the char_array pointed to by TC_chars_ptr will be "shortened"
+      --       so that it ends after the last character of the Str
+      --       parameter. For Ada 2005, this rule is dropped, so the
+      --       number of characters remains the same.
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr, 1, TC_String_4, False);
+
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_4 then
+         Report.Comment("Ada 95 result from Procedure Update - 5");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_4 then
+         Report.Comment("Amendment 1 result from Procedure Update - 5");
+      else
+         Report.Failed("Incorrect result from Procedure Update - 5");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(Item   => TC_chars_ptr,
+                 Offset => 0,
+                 Str    => TC_String_5);
+
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_5 then
+         Report.Comment("Ada 95 result from Procedure Update - 6");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_5 then
+         Report.Comment("Amendment 1 result from Procedure Update - 6");
+      else
+         Report.Failed("Incorrect result from Procedure Update - 6");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr,
+                 3,
+                 Str    => TC_String_6,
+                 Check  => True);
+
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_6 then
+         Report.Comment("Ada 95 result from Procedure Update - 7");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_6 then
+         Report.Comment("Amendment 1 result from Procedure Update - 7");
+      else
+         Report.Failed("Incorrect result from Procedure Update - 7");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr, 0, TC_String_9, True);
+
+      if ICS.Value(TC_chars_ptr) = TC_String_9 then
+         Report.Comment("Ada 95 result from Procedure Update - 8");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_9 then
+         Report.Comment("Amendment 1 result from Procedure Update - 8");
+      else
+         Report.Failed("Incorrect result from Procedure Update - 8");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+      -- Check what happens if the string and array are the same size (this
+      -- is the case that caused the change made by the Amendment).
+      begin
+         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => 0,
+                    Str    => TC_String_10,
+                    Check  => True);
+          if ICS.Value(TC_chars_ptr) = TC_String_10 then
+             Report.Comment("Amendment 1 result from Procedure Update - 9");
+          else
+             Report.Failed("Incorrect result from Procedure Update - 9");
+          end if;
+      exception
+         when ICS.Update_Error =>
+             Report.Comment("Ada 95 exception expected from Procedure Update - 9");
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Str parameter - 9");
+      end;
+      ICS.Free(TC_chars_ptr);
+
+
+      -- Check that both of the above versions of Procedure Update will
+      -- propagate Update_Error if Check is True, and if the length of
+      -- the new chars in Chars, when overlaid starting from position
+      -- Offset, will overwrite the first nul in Item.
+
+      begin
+         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => 5,
+                    Chars  => IC.To_C(TC_String_7),
+                    Check  => True);
+         Report.Failed("Update_Error not raised by Procedure Update with " &
+                       "Chars parameter");
+         Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " &
+                        "optimization - should never be printed");
+      exception
+         when ICS.Update_Error => null;  -- OK, expected exception.
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Chars parameter");
+      end;
+
+      ICS.Free(TC_chars_ptr);
+
+      begin
+         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => ICS.Strlen(TC_chars_ptr),
+                    Str    => TC_String_8); -- Default Check parameter value.
+         Report.Failed("Update_Error not raised by Procedure Update with " &
+                       "Str parameter");
+         Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " &
+                        "optimization - should never be printed");
+      exception
+         when ICS.Update_Error => null;  -- OK, expected exception.
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Str parameter");
+      end;
+
+      ICS.Free(TC_chars_ptr);
+
+      -- Check that both of the above versions of Procedure Update will
+      -- propagate Dereference_Error if Item is Null_Ptr.
+      -- Note: Free sets TC_chars_ptr to Null_Ptr.
+
+      begin
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => 5,
+                    Chars  => IC.To_C(TC_String_7),
+                    Check  => True);
+         Report.Failed("Dereference_Error not raised by Procedure Update with " &
+                       "Chars parameter");
+      exception
+         when ICS.Dereference_Error => null;  -- OK, expected exception.
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Chars parameter");
+      end;
+
+      begin
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => ICS.Strlen(TC_chars_ptr),
+                    Str    => TC_String_8); -- Default Check parameter value.
+         Report.Failed("Dereference_Error not raised by Procedure Update with " &
+                       "Str parameter");
+      exception
+         when ICS.Dereference_Error => null;  -- OK, expected exception.
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Str parameter");
+      end;
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3012;