cxb3007.a

来自「用于进行gcc测试」· A 代码 · 共 409 行 · 第 1/2 页

-- 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).