gcc/testsuite/ada/acats/tests/cxb/cxb30061.am

   1 -- CXB30061.AM
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that the function To_C maps between the Ada type Wide_Character
  28 --      and the C type wchar_t.
  29 --
  30 --      Check that the function To_Ada maps between the C type wchar_t and
  31 --      the Ada type Wide_Character.
  32 --
  33 --      Check that the function Is_Nul_Terminated returns True if the
  34 --      wchar_array parameter contains wide_nul, and otherwise False.
  35 --
  36 --      Check that the function To_C produces a correct wchar_array result,
  37 --      with lower bound of 0, and length dependent upon the Item and
  38 --      Append_Nul parameters.
  39 --
  40 --      Check that the function To_Ada produces a correct wide_string result,
  41 --      with lower bound of 1, and length dependent upon the Item and
  42 --      Trim_Nul parameters.
  43 --
  44 --      Check that the function To_Ada raises Terminator_Error if the
  45 --      parameter Trim_Nul is set to True, but the actual Item parameter
  46 --      does not contain the wide_nul wchar_t.
  47 --
  48 -- TEST DESCRIPTION:
  49 --      This test uses a variety of Wide_Character, wchar_t, Wide_String, and
  50 --      wchar_array objects to test versions of the To_C, To_Ada, and
  51 --      Is_Nul_Terminated functions.
  52 --
  53 --      This test assumes that the following characters are all included
  54 --      in the implementation defined type Interfaces.C.wchar_t:
  55 --      ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
  56 --
  57 -- APPLICABILITY CRITERIA:
  58 --      This test is applicable to all implementations that provide
  59 --      package Interfaces.C.  If an implementation provides
  60 --      package Interfaces.C, this test must compile, execute, and
  61 --      report "PASSED".
  62 --
  63 -- SPECIAL REQUIREMENTS:
  64 --      The file CXB30060.C must be compiled with a C compiler.
  65 --      Implementation dialects of C may require alteration of
  66 --      the C program syntax (see individual C files).
  67 --
  68 --      Note that the compiled C code must be bound with the compiled Ada
  69 --      code to create an executable image.  An implementation must provide
  70 --      the necessary commands to accomplish this.
  71 --
  72 --      Note that the C code included in CXB30060.C conforms
  73 --      to ANSI-C.  Modifications to these files may be required for other
  74 --      C compilers.  An implementation must provide the necessary
  75 --      modifications to satisfy the function requirements.
  76 --
  77 -- TEST FILES:
  78 --      The following files comprise this test:
  79 --
  80 --         CXB30060.C
  81 --         CXB30061.AM
  82 --
  83 -- CHANGE HISTORY:
  84 --      07 Sep 95   SAIC    Initial prerelease version.
  85 --      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
  86 --      13 Sep 99   RLB     Replaced (bogus) Unchecked_Conversions with a
  87 --                          C function character generator.
  88 --
  89 --!
  90
  91 with Report;
  92 with Interfaces.C;                                            -- N/A => ERROR
  93 with Ada.Characters.Latin_1;
  94 with Ada.Characters.Handling;
  95 with Ada.Exceptions;
  96 with Ada.Strings.Wide_Fixed;
  97 with Impdef;
  98
  99 procedure CXB30061 is
 100 begin
 101
 102    Report.Test ("CXB3006", "Check that the functions To_C and To_Ada " &
 103                            "produce correct results");
 104
 105    Test_Block:
 106    declare
 107
 108       use Interfaces, Interfaces.C;
 109       use Ada.Characters, Ada.Characters.Latin_1, Ada.Characters.Handling;
 110       use Ada.Strings.Wide_Fixed;
 111
 112       First_Character,
 113       Last_Character  : Character;
 114       TC_wchar_t,
 115       TC_Low_wchar_t,
 116       TC_High_wchar_t : wchar_t           := wchar_t'First;
 117       TC_Wide_String  : Wide_String(1..8) := (others => Wide_Character'First);
 118       TC_wchar_array  : wchar_array(0..7) := (others => C.wide_nul);
 119
 120       -- The function Char_Gen returns a character corresponding to its
 121       -- argument.
 122       --     Value   0 ..  9 ==> '0' .. '9'
 123       --     Value  10 .. 19 ==> 'A' .. 'J'
 124       --     Value  20 .. 29 ==> 'k' .. 't'
 125       --     Value  30       ==> ' '
 126       --     Value  31       ==> '.'
 127       --     Value  32       ==> ','
 128
 129       function Char_Gen (Value   : in int) return wchar_t;
 130
 131       -- Use the user-defined C function char_gen as a completion to the
 132       -- function specification above.
 133
 134       pragma Import (Convention    => C,
 135                      Entity        => Char_Gen,
 136                      External_Name => Impdef.CXB30060_External_Name);
 137
 138    begin
 139
 140       -- Check that the functions To_C and To_Ada map between the Ada type
 141       -- Wide_Character and the C type wchar_t.
 142
 143       if To_C(To_Wide_Character(Ada.Characters.Latin_1.NUL)) /=
 144          Interfaces.C.wide_nul
 145       then
 146          Report.Failed("Incorrect result from To_C with NUL character input");
 147       end if;
 148
 149       First_Character := Report.Ident_Char('k');
 150       Last_Character  := Report.Ident_Char('t');
 151       for i in First_Character..Last_Character loop
 152          if To_C(Item => To_Wide_Character(i)) /=
 153             Char_Gen(Character'Pos(i) - Character'Pos('k') + 20)
 154          then
 155             Report.Failed("Incorrect result from To_C with lower case " &
 156                           "alphabetic wide character input");
 157          end if;
 158       end loop;
 159
 160       First_Character := Report.Ident_Char('A');
 161       Last_Character  := Report.Ident_Char('J');
 162       for i in First_Character..Last_Character loop
 163          if To_C(Item => To_Wide_Character(i)) /=
 164             Char_Gen(Character'Pos(i) - Character'Pos('A') + 10)
 165          then
 166             Report.Failed("Incorrect result from To_C with upper case " &
 167                           "alphabetic wide character input");
 168          end if;
 169       end loop;
 170
 171       First_Character := Report.Ident_Char('0');
 172       Last_Character  := Report.Ident_Char('9');
 173       for i in First_Character..Last_Character loop
 174          if To_C(Item => To_Wide_Character(i)) /=
 175             Char_Gen(Character'Pos(i) - Character'Pos('0'))
 176          then
 177             Report.Failed("Incorrect result from To_C with digit " &
 178                           "wide character input");
 179          end if;
 180       end loop;
 181
 182       if To_C(Item => To_Wide_Character(' ')) /= Char_Gen(30)
 183       then
 184             Report.Failed("Incorrect result from To_C with space " &
 185                           "wide character input");
 186       end if;
 187
 188       if To_C(Item => To_Wide_Character('.')) /= Char_Gen(31)
 189       then
 190             Report.Failed("Incorrect result from To_C with dot " &
 191                           "wide character input");
 192       end if;
 193
 194       if To_C(Item => To_Wide_Character(',')) /= Char_Gen(32)
 195       then
 196             Report.Failed("Incorrect result from To_C with comma " &
 197                           "wide character input");
 198       end if;
 199
 200       if To_Ada(Interfaces.C.wide_nul) /=
 201          To_Wide_Character(Ada.Characters.Latin_1.NUL)
 202       then
 203          Report.Failed("Incorrect result from To_Ada with wide_nul " &
 204                        "wchar_t input");
 205       end if;
 206
 207       for Code in int range
 208          int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
 209             -- 'k' .. 't'
 210          if To_Ada(Item => Char_Gen(Code)) /=
 211             To_Wide_Character(Character'Val (Character'Pos('k') + (Code - 20)))
 212          then
 213             Report.Failed("Incorrect result from To_Ada with lower case " &
 214                           "alphabetic wchar_t input");
 215          end if;
 216       end loop;
 217
 218       for Code in int range
 219          int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
 220             -- 'A' .. 'J'
 221          if To_Ada(Item => Char_Gen(Code)) /=
 222             To_Wide_Character(Character'Val (Character'Pos('A') + (Code - 10)))
 223          then
 224             Report.Failed("Incorrect result from To_Ada with upper case " &
 225                           "alphabetic wchar_t input");
 226          end if;
 227       end loop;
 228
 229       for Code in int range
 230          int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
 231             -- '0' .. '9'
 232          if To_Ada(Item => Char_Gen(Code)) /=
 233             To_Wide_Character(Character'Val (Character'Pos('0') + (Code)))
 234          then
 235             Report.Failed("Incorrect result from To_Ada with digit " &
 236                           "wchar_t input");
 237          end if;
 238       end loop;
 239
 240       if To_Ada(Item => Char_Gen(30)) /= ' ' then
 241          Report.Failed("Incorrect result from To_Ada with space " &
 242                        "char input");
 243       end if;
 244       if To_Ada(Item => Char_Gen(31)) /= '.' then
 245          Report.Failed("Incorrect result from To_Ada with dot " &
 246                        "char input");
 247       end if;
 248       if To_Ada(Item => Char_Gen(32)) /= ',' then
 249          Report.Failed("Incorrect result from To_Ada with comma " &
 250                        "char input");
 251       end if;
 252
 253       -- Check that the function Is_Nul_Terminated produces correct results
 254       -- whether or not the wchar_array argument contains the
 255       -- Ada.Interfaces.C.wide_nul character.
 256
 257       TC_Wide_String := "abcdefgh";
 258       if Is_Nul_Terminated(Item => To_C(TC_Wide_String, Append_Nul => False))
 259       then
 260          Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
 261                        "wide_nul wchar_t is present");
 262       end if;
 263
 264       if not Is_Nul_Terminated(To_C(TC_Wide_String, Append_Nul => True)) then
 265          Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
 266                        "wide_nul wchar_t is present");
 267       end if;
 268
 269
 270
 271       -- Now that we've tested the character/char versions of To_Ada and To_C,
 272       -- use them to test the string versions.
 273
 274       declare
 275          i                    : size_t  := 0;
 276          j                    : integer := 1;
 277          Incorrect_Conversion : Boolean := False;
 278
 279          TC_No_wide_nul       : constant wchar_array := To_C(TC_Wide_String,
 280                                                              False);
 281          TC_wide_nul_Appended : constant wchar_array := To_C(TC_Wide_String,
 282                                                              True);
 283       begin
 284
 285          -- Check that the function To_C produces a wchar_array result with
 286          -- lower bound of 0, and length dependent upon the Item and
 287          -- Append_Nul parameters (if Append_Nul is True, length is
 288          -- Item'Length + 1; if False, length is Item'Length).
 289
 290          if TC_No_wide_nul'First /= 0 or TC_wide_nul_Appended'First /= 0 then
 291             Report.Failed("Incorrect lower bound from Function To_C");
 292          end if;
 293
 294          if TC_No_wide_nul'Length /= TC_Wide_String'Length then
 295             Report.Failed("Incorrect length returned from Function To_C " &
 296                           "when Append_Nul => False");
 297          end if;
 298
 299          if TC_wide_nul_Appended'Length /= TC_Wide_String'Length + 1 then
 300             Report.Failed("Incorrect length returned from Function To_C " &
 301                           "when Append_Nul => True");
 302          end if;
 303
 304          if not Is_Nul_Terminated(TC_wide_nul_Appended) then
 305             Report.Failed("No wide_nul appended to the wide_string "    &
 306                           "parameter during conversion to wchar_array " &
 307                           "by function To_C");
 308          end if;
 309
 310          for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
 311             if TC_No_wide_nul(i)       /= To_C(To_Wide_Character(TC_char)) or
 312                TC_wide_nul_Appended(i) /= To_C(To_Wide_Character(TC_char)) then
 313                -- Use single character To_C.
 314                Incorrect_Conversion := True;
 315             end if;
 316             i := i + 1;
 317          end loop;
 318
 319          if Incorrect_Conversion then
 320             Report.Failed("Incorrect result from To_C with wide_string input " &
 321                           "and wchar_array result");
 322          end if;
 323
 324
 325          -- Check that the function To_Ada produces a wide_string result with
 326          -- lower bound of 1, and length dependent upon the Item and
 327          -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
 328          -- if False, length will be the length of the slice of Item prior to
 329          -- the first wide_nul).
 330
 331          declare
 332             TC_No_NUL_Wide_String       : constant Wide_String :=
 333               To_Ada(Item => TC_wide_nul_Appended, Trim_Nul => True);
 334
 335             TC_NUL_Appended_Wide_String : constant Wide_String :=
 336               To_Ada(TC_wide_nul_Appended, False);
 337
 338          begin
 339
 340             if TC_No_NUL_Wide_String'First       /= 1 or
 341                TC_NUL_Appended_Wide_String'First /= 1
 342             then
 343                Report.Failed("Incorrect lower bound from Function To_Ada");
 344             end if;
 345
 346             if TC_No_NUL_Wide_String'Length /= TC_Wide_String'Length then
 347                Report.Failed("Incorrect length returned from Function " &
 348                              "To_Ada when Trim_Nul => True");
 349             end if;
 350
 351             if TC_NUL_Appended_Wide_String'Length /=
 352                TC_Wide_String'Length + 1
 353             then
 354                Report.Failed("Incorrect length returned from Function " &
 355                              "To_Ada when Trim_Nul => False");
 356             end if;
 357
 358             for TC_Character in Wide_Character'('a') .. Wide_Character'('h') loop
 359                if TC_No_NUL_Wide_String(j)       /= TC_Character or
 360                   TC_NUL_Appended_Wide_String(j) /= TC_Character
 361                then
 362                   Report.Failed("Incorrect result from To_Ada with " &
 363                                 "char_array input, index = "         &
 364                                 Integer'Image(j));
 365                end if;
 366                j := j + 1;
 367             end loop;
 368
 369          end;
 370
 371
 372          -- Check that the function To_Ada raises Terminator_Error if the
 373          -- parameter Trim_Nul is set to True, but the actual Item parameter
 374          -- does not contain the wide_nul wchar_t.
 375
 376          begin
 377             TC_Wide_String := To_Ada(TC_No_wide_nul, Trim_Nul => True);
 378             Report.Failed("Terminator_Error not raised when Item "    &
 379                           "parameter of To_Ada does not contain the " &
 380                           "wide_nul wchar_t, but parameter Trim_Nul " &
 381                           "=> True");
 382             Report.Comment
 383               (To_String(TC_Wide_String) & " printed to defeat optimization");
 384          exception
 385             when Terminator_Error => null;  -- OK, expected exception.
 386             when others           =>
 387                Report.Failed("Incorrect exception raised by function "  &
 388                              "To_Ada when the Item parameter does not " &
 389                              "contain the wide_nul wchar_t, but "       &
 390                              "parameter Trim_Nul => True");
 391          end;
 392
 393       end;
 394
 395    exception
 396       when The_Error : others =>
 397          Report.Failed
 398            ("The following exception was raised in the Test_Block: " &
 399             Ada.Exceptions.Exception_Name(The_Error));
 400    end Test_Block;
 401
 402    Report.Result;
 403
 404 end CXB30061;