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

diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a b/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a
new file mode 100644
index 000000000..3837e0bae
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a
@@ -0,0 +1,408 @@
+-- CXB3007.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 procedure To_C converts the Wide_Character elements
+--      of a Wide_String parameter into wchar_t elements of the wchar_array
+--      parameter Target, with wide_nul termination if parameter Append_Nul
+--      is true.
+--
+--      Check that the out parameter Count of procedure To_C is set to the
+--      appropriate value for both the wide_nul/no wide_nul terminated cases.
+--
+--      Check that Constraint_Error is propagated by procedure To_C if the
+--      length of the wchar_array parameter Target is not sufficient to
+--      hold the converted Wide_String value.
+--
+--      Check that the Procedure To_Ada converts wchar_t elements of the
+--      wchar_array parameter Item to the corresponding Wide_Character
+--      elements of Wide_String out parameter Target.
+--
+--      Check that Constraint_Error is propagated by Procedure To_Ada if the
+--      length of Wide_String parameter Target is not long enough to hold the
+--      converted wchar_array value.
+--
+--      Check that Terminator_Error is propagated by Procedure To_Ada if the
+--      parameter Trim_Nul is set to True, but the actual Item parameter
+--      contains no wide_nul wchar_t.
+--
+-- TEST DESCRIPTION:
+--      This test uses a variety of Wide_String, and wchar_array objects to
+--      test versions of the To_C and To_Ada procedures.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.wchar_t:
+--      ' ', 'a'..'z', 'A'..'Z', and '-'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.  If an implementation provides
+--      package Interfaces.C, this test must compile, execute, and
+--      report "PASSED".
+--
+-- CHANGE HISTORY:
+--      01 Sep 95   SAIC    Initial prerelease version.
+--      09 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.
+--
+--!
+
+with Report;
+with Interfaces.C;                                            -- N/A => ERROR
+with Ada.Characters.Latin_1;
+with Ada.Characters.Handling;
+with Ada.Exceptions;
+with Ada.Strings.Wide_Fixed;
+
+procedure CXB3007 is
+begin
+
+   Report.Test ("CXB3007", "Check that the procedures To_C and To_Ada " &
+                           "for wide strings produce correct results");
+   Test_Block:
+   declare
+
+      use Interfaces, Interfaces.C;
+      use Ada.Characters, Ada.Characters.Handling;
+      use Ada.Exceptions;
+      use Ada.Strings.Wide_Fixed;
+
+      TC_Short_Wide_String  : Wide_String(1..4) :=
+                                         (others => Wide_Character'First);
+      TC_Wide_String        : Wide_String(1..8) :=
+                                         (others => Wide_Character'First);
+      TC_wchar_array        : wchar_array(0..7) := (others => wchar_t'First);
+      TC_size_t_Count       : size_t            := size_t'First;
+      TC_Natural_Count      : Natural           := Natural'First;
+
+
+      -- We can use the wide character forms of To_Ada and To_C here to check
+      -- the results; they were tested in CXB3006. We give them different
+      -- names to avoid confusion below.
+
+      function Wide_Character_to_wchar_t (Source : in Wide_Character)
+          return wchar_t renames To_C;
+      function wchar_t_to_Wide_Character (Source : in wchar_t)
+          return Wide_Character renames To_Ada;
+
+   begin
+
+      -- Check that the procedure To_C converts the Wide_Character elements
+      -- of a Wide_String parameter into wchar_t elements of wchar_array out
+      -- parameter Target.
+      --
+      -- Case of wide_nul termination.
+
+      TC_Wide_String(1..6) := "abcdef";
+
+      To_C (Item       => TC_Wide_String(1..6),  -- Source slice of length 6.
+            Target     => TC_wchar_array,
+            Count      => TC_size_t_Count,
+            Append_Nul => True);
+
+      -- Check that the out parameter Count is set to the appropriate value
+      -- for the wide_nul terminated case.
+
+      if TC_size_t_Count /= 7 then
+         Report.Failed("Incorrect setting of out parameter Count by " &
+                       "Procedure To_C when Append_Nul => True");
+      end if;
+
+      for i in 1..TC_size_t_Count-1 loop
+         if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
+            TC_Wide_String(Integer(i))
+         then
+            Report.Failed("Incorrect result from Procedure To_C when "    &
+                          "checking individual wchar_t values, case of "  &
+                          "Append_Nul => True; "                          &
+                          "wchar_t position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if not Is_Nul_Terminated(TC_wchar_array) then
+         Report.Failed("No wide_nul wchar_t appended to the wchar_array " &
+                       "result from Procedure To_C when Append_Nul => True");
+      end if;
+
+      if TC_wchar_array(0..6) /= To_C("abcdef", True) then
+         Report.Failed("Incorrect result from Procedure To_C when "   &
+                       "directly comparing wchar_array results, case " &
+                       "of Append_Nul => True");
+      end if;
+
+
+      -- Check Procedure To_C with no wide_nul termination.
+
+      TC_wchar_array       := (others => Wide_Character_to_wchar_t('M'));
+      TC_Wide_String(1..4) := "WXYZ";
+
+      To_C (Item       => TC_Wide_String(1..4),  -- Source slice of length 4.
+            Target     => TC_wchar_array,
+            Count      => TC_size_t_Count,
+            Append_Nul => False);
+
+      -- Check that the out parameter Count is set to the appropriate value
+      -- for the non-wide_nul terminated case.
+
+      if TC_size_t_Count /= 4 then
+         Report.Failed("Incorrect setting of out parameter Count by " &
+                       "Procedure To_C when Append_Nul => False");
+      end if;
+
+      for i in 1..TC_size_t_Count loop
+         if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
+            TC_Wide_String(Integer(i))
+         then
+            Report.Failed("Incorrect result from Procedure To_C when "    &
+                          "checking individual wchar_t values, case of "  &
+                          "Append_Nul => False; "                         &
+                          "wchar_t position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if Is_Nul_Terminated(TC_wchar_array) then
+         Report.Failed
+           ("The wide_nul wchar_t was appended to the wchar_array " &
+            "result of Procedure To_C when Append_Nul => False");
+      end if;
+
+      if TC_wchar_array(0..3) /= To_C("WXYZ", False) then
+         Report.Failed("Incorrect result from Procedure To_C when "    &
+                       "directly comparing wchar_array results, case " &
+                       "of Append_Nul => False");
+      end if;
+
+
+
+      -- Check that Constraint_Error is raised by procedure To_C if the
+      -- length of the target wchar_array parameter is not sufficient to
+      -- hold the converted Wide_String value (plus wide_nul if Append_Nul
+      -- is True).
+
+      TC_wchar_array := (others => wchar_t'First);
+      begin
+         To_C("A string too long",
+              TC_wchar_array,
+              TC_size_t_Count,
+              Append_Nul => True);
+
+         Report.Failed("Constraint_Error not raised when the Target "    &
+                       "parameter of Procedure To_C is not long enough " &
+                       "to hold the converted Wide_String");
+         Report.Comment
+           (To_Character(wchar_t_to_Wide_Character(TC_wchar_array(0))) &
+            " printed to defeat optimization");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure "    &
+                          "To_C when the Target parameter is not long " &
+                          "enough to contain the wchar_array result");
+      end;
+
+
+
+      -- Check that the procedure To_Ada converts wchar_t elements of the
+      -- wchar_array parameter Item to the corresponding Wide_Character
+      -- elements of Wide_String out parameter Target, with result wide
+      -- string length based on the Trim_Nul parameter.
+      --
+      -- Case of appended wide_nul wchar_t on the wchar_array In parameter.
+
+      TC_wchar_array :=
+        To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
+
+      To_Ada (Item     => TC_wchar_array,
+              Target   => TC_Wide_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => False);
+
+      if TC_Natural_Count /= 8 then
+         Report.Failed("Incorrect value returned in out parameter Count " &
+                       "by Procedure To_Ada, case of Trim_Nul => False");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
+            TC_wchar_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when "   &
+                          "checking individual wchar_t values, case of "   &
+                          "Trim_Nul => False, when a wide_nul is present " &
+                          "in the wchar_array input parameter; "           &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_Wide_String(TC_Natural_Count) /= To_Wide_Character(Latin_1.Nul)
+      then
+         Report.Failed("Last Wide_Character of Wide_String result of "      &
+                       "Procedure To_Ada is not Nul, even though a "        &
+                       "wide_nul was present in the wchar_array argument, " &
+                       "and the Trim_Nul parameter was set to False");
+      end if;
+
+
+      TC_Wide_String       := (others => Wide_Character'First);
+      TC_wchar_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
+
+      To_Ada (Item     => TC_wchar_array,
+              Target   => TC_Wide_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => True);
+
+      if TC_Natural_Count /= 3 then
+         Report.Failed("Incorrect value returned in out parameter Count " &
+                       "by Procedure To_Ada, case of Trim_Nul => True");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
+            TC_wchar_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when "  &
+                          "checking individual wchar_t values, case of "  &
+                          "Trim_Nul => True, when a wide_nul is present " &
+                          "in the wchar_array input parameter; "          &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
+      then
+         Report.Failed("Last Wide_Character of Wide_String result of " &
+                       "Procedure To_Ada is  Nul, even though the "    &
+                       "Trim_Nul parameter was set to True");
+      end if;
+
+      if TC_Wide_String(TC_Natural_Count+1) /= Wide_Character'First then
+         Report.Failed("Incorrect replacement from To_Ada");
+      end if;
+
+
+      -- Case of no wide_nul wchar_t present in the wchar_array argument.
+
+      TC_Wide_String := (others => Wide_Character'First);
+      TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
+
+      To_Ada (Item     => TC_wchar_array,
+              Target   => TC_Wide_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => False);
+
+      if TC_Natural_Count /= 8 then
+         Report.Failed("Incorrect value returned in out parameter Count "   &
+                       "by Procedure To_Ada, case of Trim_Nul => False, "   &
+                       "with no wide_nul wchar_t present in the parameter " &
+                       "Item");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
+            TC_wchar_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when " &
+                          "checking individual wchar_t values, case of " &
+                          "Trim_Nul => False, when a wide_nul is not "   &
+                          "present in the wchar_array input parameter; " &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
+      then
+         Report.Failed("Last Wide_Character of Wide_String result of "      &
+                       "Procedure To_Ada is Nul, even though the wide_nul " &
+                       "wchar_t was not present in the parameter Item, "    &
+                       "with the parameter Trim_Nul => False");
+      end if;
+
+
+
+      -- Check that the Procedure To_Ada raises Terminator_Error if the
+      -- parameter Trim_Nul is set to True, but the actual Item parameter
+      -- does not contain the wide_nul wchar_t.
+
+      begin
+         TC_Wide_String := (others => Wide_Character'First);
+         TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
+
+         To_Ada(TC_wchar_array,
+                TC_Wide_String,
+                Count    => TC_Natural_Count,
+                Trim_Nul => True);
+
+         Report.Failed("Terminator_Error not raised when Item "    &
+                       "parameter of To_Ada does not contain the " &
+                       "wide_nul wchar_t, but parameter Trim_Nul => True");
+         Report.Comment(To_String(TC_Wide_String) &
+                        " printed to defeat optimization");
+      exception
+         when Terminator_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure "     &
+                          "To_Ada when the Item parameter does not "     &
+                          "contain the wide_nul wchar_t, but parameter " &
+                          "Trim_Nul => True");
+      end;
+
+
+
+      -- Check that Constraint_Error is propagated by procedure To_Ada if the
+      -- length of Wide_String parameter Target is not long enough to hold the
+      -- converted wchar_array value (plus wide_nul if Trim_Nul is False).
+
+      begin
+         TC_wchar_array(0..4) := To_C ("ABCD", Append_Nul => True);
+
+         To_Ada(TC_wchar_array(0..4),
+                TC_Short_Wide_String, -- Length of 4.
+                Count    => TC_Natural_Count,
+                Trim_Nul => False);
+
+         Report.Failed("Constraint_Error not raised when Wide_String " &
+                       "parameter Target of Procedure To_Ada is not "  &
+                       "long enough to hold the converted wchar_ts");
+         Report.Comment(To_String(TC_Short_Wide_String) &
+                        " printed to defeat optimization");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure "      &
+                          "To_Ada when Wide_String parameter Target is "  &
+                          "not long enough to hold the converted wchar_ts");
+      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 CXB3007;