path: root/gcc/testsuite/ada/acats/tests/cxb/cxb30061.am

-- CXB30061.AM
--
--                             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 function To_C maps between the Ada type Wide_Character
--      and the C type wchar_t.
--
--      Check that the function To_Ada maps between the C type wchar_t and
--      the Ada type Wide_Character.
--
--      Check that the function Is_Nul_Terminated returns True if the
--      wchar_array parameter contains wide_nul, and otherwise False.
--
--      Check that the function To_C produces a correct wchar_array result,
--      with lower bound of 0, and length dependent upon the Item and
--      Append_Nul parameters.
--
--      Check that the function To_Ada produces a correct wide_string result,
--      with lower bound of 1, and length dependent upon the Item and
--      Trim_Nul parameters.
--
--      Check that the function 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.
--
-- TEST DESCRIPTION:
--      This test uses a variety of Wide_Character, wchar_t, Wide_String, and
--      wchar_array objects to test versions of the To_C, To_Ada, and
--      Is_Nul_Terminated functions.
--
--      This test assumes that the following characters are all included
--      in the implementation defined type Interfaces.C.wchar_t:
--      ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
--
-- 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".
--
-- SPECIAL REQUIREMENTS:
--      The file CXB30060.C must be compiled with a C compiler.
--      Implementation dialects of C may require alteration of
--      the C program syntax (see individual C files).
--
--      Note that the compiled C code must be bound with the compiled Ada
--      code to create an executable image.  An implementation must provide
--      the necessary commands to accomplish this.
--
--      Note that the C code included in CXB30060.C conforms
--      to ANSI-C.  Modifications to these files may be required for other
--      C compilers.  An implementation must provide the necessary
--      modifications to satisfy the function requirements.
--
-- TEST FILES:
--      The following files comprise this test:
--
--         CXB30060.C
--         CXB30061.AM
--
-- CHANGE HISTORY:
--      07 Sep 95   SAIC    Initial prerelease version.
--      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
--      13 Sep 99   RLB     Replaced (bogus) Unchecked_Conversions with a
--                          C function character generator.
--
--!

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;
with Impdef;

procedure CXB30061 is
begin

   Report.Test ("CXB3006", "Check that the functions To_C and To_Ada " &
                           "produce correct results");

   Test_Block:
   declare

      use Interfaces, Interfaces.C;
      use Ada.Characters, Ada.Characters.Latin_1, Ada.Characters.Handling;
      use Ada.Strings.Wide_Fixed;

      First_Character,
      Last_Character  : Character;
      TC_wchar_t,
      TC_Low_wchar_t,
      TC_High_wchar_t : wchar_t           := wchar_t'First;
      TC_Wide_String  : Wide_String(1..8) := (others => Wide_Character'First);
      TC_wchar_array  : wchar_array(0..7) := (others => C.wide_nul);

      -- The function Char_Gen returns a character corresponding to its
      -- argument.
      --     Value   0 ..  9 ==> '0' .. '9'
      --     Value  10 .. 19 ==> 'A' .. 'J'
      --     Value  20 .. 29 ==> 'k' .. 't'
      --     Value  30       ==> ' '
      --     Value  31       ==> '.'
      --     Value  32       ==> ','

      function Char_Gen (Value   : in int) return wchar_t;

      -- Use the user-defined C function char_gen as a completion to the
      -- function specification above.

      pragma Import (Convention    => C,
                     Entity        => Char_Gen,
                     External_Name => Impdef.CXB30060_External_Name);

   begin

      -- Check that the functions To_C and To_Ada map between the Ada type
      -- Wide_Character and the C type wchar_t.

      if To_C(To_Wide_Character(Ada.Characters.Latin_1.NUL)) /=
         Interfaces.C.wide_nul
      then
         Report.Failed("Incorrect result from To_C with NUL character input");
      end if;

      First_Character := Report.Ident_Char('k');
      Last_Character  := Report.Ident_Char('t');
      for i in First_Character..Last_Character loop
         if To_C(Item => To_Wide_Character(i)) /=
	    Char_Gen(Character'Pos(i) - Character'Pos('k') + 20)
         then
            Report.Failed("Incorrect result from To_C with lower case " &
                          "alphabetic wide character input");
         end if;
      end loop;

      First_Character := Report.Ident_Char('A');
      Last_Character  := Report.Ident_Char('J');
      for i in First_Character..Last_Character loop
         if To_C(Item => To_Wide_Character(i)) /=
	    Char_Gen(Character'Pos(i) - Character'Pos('A') + 10)
         then
            Report.Failed("Incorrect result from To_C with upper case " &
                          "alphabetic wide character input");
         end if;
      end loop;

      First_Character := Report.Ident_Char('0');
      Last_Character  := Report.Ident_Char('9');
      for i in First_Character..Last_Character loop
         if To_C(Item => To_Wide_Character(i)) /=
	    Char_Gen(Character'Pos(i) - Character'Pos('0'))
         then
            Report.Failed("Incorrect result from To_C with digit " &
                          "wide character input");
         end if;
      end loop;

      if To_C(Item => To_Wide_Character(' ')) /= Char_Gen(30)
      then
            Report.Failed("Incorrect result from To_C with space " &
                          "wide character input");
      end if;

      if To_C(Item => To_Wide_Character('.')) /= Char_Gen(31)
      then
            Report.Failed("Incorrect result from To_C with dot " &
                          "wide character input");
      end if;

      if To_C(Item => To_Wide_Character(',')) /= Char_Gen(32)
      then
            Report.Failed("Incorrect result from To_C with comma " &
                          "wide character input");
      end if;

      if To_Ada(Interfaces.C.wide_nul) /=
         To_Wide_Character(Ada.Characters.Latin_1.NUL)
      then
         Report.Failed("Incorrect result from To_Ada with wide_nul " &
                       "wchar_t input");
      end if;

      for Code in int range
         int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
            -- 'k' .. 't'
         if To_Ada(Item => Char_Gen(Code)) /=
	    To_Wide_Character(Character'Val (Character'Pos('k') + (Code - 20)))
         then
            Report.Failed("Incorrect result from To_Ada with lower case " &
                          "alphabetic wchar_t input");
         end if;
      end loop;

      for Code in int range
         int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
            -- 'A' .. 'J'
         if To_Ada(Item => Char_Gen(Code)) /=
	    To_Wide_Character(Character'Val (Character'Pos('A') + (Code - 10)))
         then
            Report.Failed("Incorrect result from To_Ada with upper case " &
                          "alphabetic wchar_t input");
         end if;
      end loop;

      for Code in int range
         int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
            -- '0' .. '9'
         if To_Ada(Item => Char_Gen(Code)) /=
	    To_Wide_Character(Character'Val (Character'Pos('0') + (Code)))
         then
            Report.Failed("Incorrect result from To_Ada with digit " &
                          "wchar_t input");
         end if;
      end loop;

      if To_Ada(Item => Char_Gen(30)) /= ' ' then
         Report.Failed("Incorrect result from To_Ada with space " &
                       "char input");
      end if;
      if To_Ada(Item => Char_Gen(31)) /= '.' then
         Report.Failed("Incorrect result from To_Ada with dot " &
                       "char input");
      end if;
      if To_Ada(Item => Char_Gen(32)) /= ',' then
         Report.Failed("Incorrect result from To_Ada with comma " &
                       "char input");
      end if;

      -- Check that the function Is_Nul_Terminated produces correct results
      -- whether or not the wchar_array argument contains the
      -- Ada.Interfaces.C.wide_nul character.

      TC_Wide_String := "abcdefgh";
      if Is_Nul_Terminated(Item => To_C(TC_Wide_String, Append_Nul => False))
      then
         Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
                       "wide_nul wchar_t is present");
      end if;

      if not Is_Nul_Terminated(To_C(TC_Wide_String, Append_Nul => True)) then
         Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
                       "wide_nul wchar_t is present");
      end if;



      -- Now that we've tested the character/char versions of To_Ada and To_C,
      -- use them to test the string versions.

      declare
         i                    : size_t  := 0;
         j                    : integer := 1;
         Incorrect_Conversion : Boolean := False;

         TC_No_wide_nul       : constant wchar_array := To_C(TC_Wide_String,
                                                             False);
         TC_wide_nul_Appended : constant wchar_array := To_C(TC_Wide_String,
                                                             True);
      begin

         -- Check that the function To_C produces a wchar_array result with
         -- lower bound of 0, and length dependent upon the Item and
         -- Append_Nul parameters (if Append_Nul is True, length is
         -- Item'Length + 1; if False, length is Item'Length).

         if TC_No_wide_nul'First /= 0 or TC_wide_nul_Appended'First /= 0 then
            Report.Failed("Incorrect lower bound from Function To_C");
         end if;

         if TC_No_wide_nul'Length /= TC_Wide_String'Length then
            Report.Failed("Incorrect length returned from Function To_C " &
                          "when Append_Nul => False");
         end if;

         if TC_wide_nul_Appended'Length /= TC_Wide_String'Length + 1 then
            Report.Failed("Incorrect length returned from Function To_C " &
                          "when Append_Nul => True");
         end if;

         if not Is_Nul_Terminated(TC_wide_nul_Appended) then
            Report.Failed("No wide_nul appended to the wide_string "    &
                          "parameter during conversion to wchar_array " &
                          "by function To_C");
         end if;

         for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
            if TC_No_wide_nul(i)       /= To_C(To_Wide_Character(TC_char)) or
               TC_wide_nul_Appended(i) /= To_C(To_Wide_Character(TC_char)) then
               -- Use single character To_C.
               Incorrect_Conversion := True;
            end if;
            i := i + 1;
         end loop;

         if Incorrect_Conversion then
            Report.Failed("Incorrect result from To_C with wide_string input " &
                          "and wchar_array result");
         end if;


         -- Check that the function To_Ada produces a wide_string result with
         -- lower bound of 1, and length dependent upon the Item and
         -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
         -- if False, length will be the length of the slice of Item prior to
         -- the first wide_nul).

         declare
            TC_No_NUL_Wide_String       : constant Wide_String :=
              To_Ada(Item => TC_wide_nul_Appended, Trim_Nul => True);

            TC_NUL_Appended_Wide_String : constant Wide_String :=
              To_Ada(TC_wide_nul_Appended, False);

         begin

            if TC_No_NUL_Wide_String'First       /= 1 or
               TC_NUL_Appended_Wide_String'First /= 1
            then
               Report.Failed("Incorrect lower bound from Function To_Ada");
            end if;

            if TC_No_NUL_Wide_String'Length /= TC_Wide_String'Length then
               Report.Failed("Incorrect length returned from Function " &
                             "To_Ada when Trim_Nul => True");
            end if;

            if TC_NUL_Appended_Wide_String'Length /=
               TC_Wide_String'Length + 1
            then
               Report.Failed("Incorrect length returned from Function " &
                             "To_Ada when Trim_Nul => False");
            end if;

            for TC_Character in Wide_Character'('a') .. Wide_Character'('h') loop
               if TC_No_NUL_Wide_String(j)       /= TC_Character or
                  TC_NUL_Appended_Wide_String(j) /= TC_Character
               then
                  Report.Failed("Incorrect result from To_Ada with " &
                                "char_array input, index = "         &
                                Integer'Image(j));
               end if;
               j := j + 1;
            end loop;

         end;


         -- Check that the function 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 := To_Ada(TC_No_wide_nul, 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 function "  &
                             "To_Ada when the Item parameter does not " &
                             "contain the wide_nul wchar_t, but "       &
                             "parameter Trim_Nul => True");
         end;

      end;

   exception
      when The_Error : others =>
         Report.Failed
           ("The following exception was raised in the Test_Block: " &
            Ada.Exceptions.Exception_Name(The_Error));
   end Test_Block;

   Report.Result;

end CXB30061;