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

   1 -- CXB30041.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 functions To_C and To_Ada map between the Ada type
  28 --      Character and the C type char.
  29 --
  30 --      Check that the function Is_Nul_Terminated returns True if the
  31 --      char_array parameter contains nul, and otherwise False.
  32 --
  33 --      Check that the function To_C produces a correct char_array result,
  34 --      with lower bound of 0, and length dependent upon the Item and
  35 --      Append_Nul parameters.
  36 --
  37 --      Check that the function To_Ada produces a correct string result, with
  38 --      lower bound of 1, and length dependent upon the Item and Trim_Nul
  39 --      parameters.
  40 --
  41 --      Check that the function To_Ada raises Terminator_Error if the
  42 --      parameter Trim_Nul is set to True, but the actual Item parameter
  43 --      does not contain the nul char.
  44 --
  45 -- TEST DESCRIPTION:
  46 --      This test uses a variety of Character, char, String, and char_array
  47 --      objects to test versions of the To_C, To_Ada, and Is_Nul_Terminated
  48 --      functions.
  49 --
  50 --      This test assumes that the following characters are all included
  51 --      in the implementation defined type Interfaces.C.char:
  52 --      ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
  53 --
  54 -- APPLICABILITY CRITERIA:
  55 --      This test is applicable to all implementations that provide
  56 --      package Interfaces.C.  If an implementation provides
  57 --      package Interfaces.C, this test must compile, execute, and
  58 --      report "PASSED".
  59 --
  60 -- SPECIAL REQUIREMENTS:
  61 --      The file CXB30040.C must be compiled with a C compiler.
  62 --      Implementation dialects of C may require alteration of
  63 --      the C program syntax (see individual C files).
  64 --
  65 --      Note that the compiled C code must be bound with the compiled Ada
  66 --      code to create an executable image.  An implementation must provide
  67 --      the necessary commands to accomplish this.
  68 --
  69 --      Note that the C code included in CXB30040.C conforms
  70 --      to ANSI-C.  Modifications to these files may be required for other
  71 --      C compilers.  An implementation must provide the necessary
  72 --      modifications to satisfy the function requirements.
  73 --
  74 -- TEST FILES:
  75 --      The following files comprise this test:
  76 --
  77 --         CXB30040.C
  78 --         CXB30041.AM
  79 --
  80 -- CHANGE HISTORY:
  81 --      30 Aug 95   SAIC    Initial prerelease version.
  82 --      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
  83 --      26 Oct 96   SAIC    Incorporated reviewer comments.
  84 --      13 Sep 99   RLB     Replaced (bogus) Unchecked_Conversions with a
  85 --                          C function character generator.
  86 --
  87 --!
  88
  89 with Report;
  90 with Interfaces.C;                                            -- N/A => ERROR
  91 with Ada.Characters.Latin_1;
  92 with Ada.Exceptions;
  93 with Ada.Strings.Fixed;
  94 with Impdef;
  95
  96 procedure CXB30041 is
  97 begin
  98
  99    Report.Test ("CXB3004", "Check that the functions To_C and To_Ada " &
 100                            "produce correct results");
 101
 102    Test_Block:
 103    declare
 104
 105       use Interfaces, Interfaces.C;
 106       use Ada.Characters, Ada.Characters.Latin_1;
 107       use Ada.Exceptions;
 108       use Ada.Strings.Fixed;
 109
 110       Start_Character,
 111       Stop_Character,
 112       TC_Character    : Character         := Character'First;
 113       TC_char,
 114       TC_Low_char,
 115       TC_High_char    : char              := char'First;
 116       TC_String       : String(1..8)      := (others => Latin_1.NUL);
 117       TC_char_array   : char_array(0..7)  := (others => C.nul);
 118
 119       -- The function Char_Gen returns a character corresponding to its
 120       -- argument.
 121       --     Value   0 ..  9 ==> '0' .. '9'
 122       --     Value  10 .. 19 ==> 'A' .. 'J'
 123       --     Value  20 .. 29 ==> 'k' .. 't'
 124       --     Value  30       ==> ' '
 125       --     Value  31       ==> '.'
 126       --     Value  32       ==> ','
 127
 128       function Char_Gen (Value   : in int) return char;
 129
 130       -- Use the user-defined C function char_gen as a completion to the
 131       -- function specification above.
 132
 133       pragma Import (Convention    => C,
 134                      Entity        => Char_Gen,
 135                      External_Name => Impdef.CXB30040_External_Name);
 136
 137    begin
 138
 139       -- Check that the functions To_C and To_Ada map between the Ada type
 140       -- Character and the C type char.
 141
 142       if To_C(Ada.Characters.Latin_1.NUL) /= Interfaces.C.nul then
 143          Report.Failed("Incorrect result from To_C with NUL character input");
 144       end if;
 145
 146       Start_Character := Report.Ident_Char('k');
 147       Stop_Character  := Report.Ident_Char('t');
 148       for TC_Character in Start_Character..Stop_Character loop
 149          if To_C(Item => TC_Character) /=
 150             Char_Gen(Character'Pos(TC_Character) - Character'Pos('k') + 20) then
 151             Report.Failed("Incorrect result from To_C with lower case " &
 152                           "alphabetic character input");
 153          end if;
 154       end loop;
 155
 156       Start_Character := Report.Ident_Char('A');
 157       Stop_Character  := Report.Ident_Char('J');
 158       for TC_Character in Start_Character..Stop_Character loop
 159          if To_C(Item => TC_Character) /=
 160             Char_Gen(Character'Pos(TC_Character) - Character'Pos('A') + 10) then
 161             Report.Failed("Incorrect result from To_C with upper case " &
 162                           "alphabetic character input");
 163          end if;
 164       end loop;
 165
 166       Start_Character := Report.Ident_Char('0');
 167       Stop_Character  := Report.Ident_Char('9');
 168       for TC_Character in Start_Character..Stop_Character loop
 169          if To_C(Item => TC_Character) /=
 170             Char_Gen(Character'Pos(TC_Character) - Character'Pos('0')) then
 171             Report.Failed("Incorrect result from To_C with digit " &
 172                           "character input");
 173          end if;
 174       end loop;
 175       if To_C(Item => ' ') /= Char_Gen(30) then
 176          Report.Failed("Incorrect result from To_C with space " &
 177                        "character input");
 178       end if;
 179       if To_C(Item => '.') /= Char_Gen(31) then
 180          Report.Failed("Incorrect result from To_C with dot " &
 181                        "character input");
 182       end if;
 183       if To_C(Item => ',') /= Char_Gen(32) then
 184          Report.Failed("Incorrect result from To_C with comma " &
 185                        "character input");
 186       end if;
 187
 188       if To_Ada(Interfaces.C.nul) /= Ada.Characters.Latin_1.NUL then
 189          Report.Failed("Incorrect result from To_Ada with nul char input");
 190       end if;
 191
 192       for Code in int range
 193          int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
 194             -- 'k' .. 't'
 195          if To_Ada(Item => Char_Gen(Code)) /=
 196             Character'Val (Character'Pos('k') + (Code - 20)) then
 197             Report.Failed("Incorrect result from To_Ada with lower case " &
 198                           "alphabetic char input");
 199          end if;
 200       end loop;
 201
 202       for Code in int range
 203          int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
 204             -- 'A' .. 'J'
 205          if To_Ada(Item => Char_Gen(Code)) /=
 206             Character'Val (Character'Pos('A') + (Code - 10)) then
 207             Report.Failed("Incorrect result from To_Ada with upper case " &
 208                           "alphabetic char input");
 209          end if;
 210       end loop;
 211
 212       for Code in int range
 213          int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
 214             -- '0' .. '9'
 215          if To_Ada(Item => Char_Gen(Code)) /=
 216             Character'Val (Character'Pos('0') + (Code)) then
 217             Report.Failed("Incorrect result from To_Ada with digit " &
 218                           "char input");
 219          end if;
 220       end loop;
 221
 222       if To_Ada(Item => Char_Gen(30)) /= ' ' then
 223          Report.Failed("Incorrect result from To_Ada with space " &
 224                        "char input");
 225       end if;
 226       if To_Ada(Item => Char_Gen(31)) /= '.' then
 227          Report.Failed("Incorrect result from To_Ada with dot " &
 228                        "char input");
 229       end if;
 230       if To_Ada(Item => Char_Gen(32)) /= ',' then
 231          Report.Failed("Incorrect result from To_Ada with comma " &
 232                        "char input");
 233       end if;
 234
 235       -- Check that the function Is_Nul_Terminated produces correct results
 236       -- whether or not the char_array argument contains the
 237       -- Ada.Interfaces.C.nul character.
 238
 239       TC_String := "abcdefgh";
 240       if Is_Nul_Terminated(Item => To_C(TC_String, Append_Nul => False)) then
 241          Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
 242                        "nul char is present");
 243       end if;
 244
 245       if not Is_Nul_Terminated(To_C(TC_String, Append_Nul => True)) then
 246          Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
 247                        "nul char is present");
 248       end if;
 249
 250
 251       -- Now that we've tested the character/char versions of To_Ada and To_C,
 252       -- use them to test the string versions.
 253
 254       declare
 255          i                    : size_t  := 0;
 256          j                    : integer := 1;
 257          Incorrect_Conversion : Boolean := False;
 258
 259          TC_No_nul       : constant char_array := To_C(TC_String, False);
 260          TC_nul_Appended : constant char_array := To_C(TC_String, True);
 261       begin
 262
 263          -- Check that the function To_C produces a char_array result with
 264          -- lower bound of 0, and length dependent upon the Item and
 265          -- Append_Nul parameters (if Append_Nul is True, length is
 266          -- Item'Length + 1; if False, length is Item'Length).
 267
 268          if TC_No_nul'First /= 0 or TC_nul_Appended'First /= 0 then
 269             Report.Failed("Incorrect lower bound from Function To_C");
 270          end if;
 271
 272          if TC_No_nul'Length /= TC_String'Length then
 273             Report.Failed("Incorrect length returned from Function To_C " &
 274                           "when Append_Nul => False");
 275          end if;
 276
 277          for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
 278             if TC_No_nul(i)       /= To_C(TC_char) or -- Single character To_C.
 279                TC_nul_Appended(i) /= To_C(TC_char) then
 280                Incorrect_Conversion := True;
 281             end if;
 282             i := i + 1;
 283          end loop;
 284
 285          if Incorrect_Conversion then
 286             Report.Failed("Incorrect result from To_C with string input " &
 287                           "and char_array result");
 288          end if;
 289
 290
 291          if TC_nul_Appended'Length /= TC_String'Length + 1 then
 292             Report.Failed("Incorrect length returned from Function To_C " &
 293                           "when Append_Nul => True");
 294          end if;
 295
 296          if not Is_Nul_Terminated(TC_nul_Appended) then
 297             Report.Failed("No nul appended to the string parameter during " &
 298                           "conversion to char_array by function To_C");
 299          end if;
 300
 301
 302          -- Check that the function To_Ada produces a string result with
 303          -- lower bound of 1, and length dependent upon the Item and
 304          -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
 305          -- if True, length will be the length of the slice of Item prior to
 306          -- the first nul).
 307
 308          declare
 309             TC_No_NUL_String       : constant String :=
 310                                        To_Ada(Item     => TC_nul_Appended,
 311                                               Trim_Nul => True);
 312             TC_NUL_Appended_String : constant String :=
 313                                        To_Ada(TC_nul_Appended, False);
 314          begin
 315
 316             if TC_No_NUL_String'First       /= 1 or
 317                TC_NUL_Appended_String'First /= 1
 318             then
 319                Report.Failed("Incorrect lower bound from Function To_Ada");
 320             end if;
 321
 322             if TC_No_NUL_String'Length /= TC_String'Length then
 323                Report.Failed("Incorrect length returned from Function " &
 324                              "To_Ada when Trim_Nul => True");
 325             end if;
 326
 327             if TC_NUL_Appended_String'Length /= TC_String'Length + 1 then
 328                Report.Failed("Incorrect length returned from Function " &
 329                              "To_Ada when Trim_Nul => False");
 330             end if;
 331
 332             Start_Character := Report.Ident_Char('a');
 333             Stop_Character  := Report.Ident_Char('h');
 334             for TC_Character in Start_Character..Stop_Character loop
 335                if TC_No_NUL_String(j)       /= TC_Character or
 336                   TC_NUL_Appended_String(j) /= TC_Character
 337                then
 338                   Report.Failed("Incorrect result from To_Ada with " &
 339                                 "char_array input, index = "         &
 340                                 Integer'Image(j));
 341                end if;
 342                j := j + 1;
 343             end loop;
 344
 345          end;
 346
 347
 348          -- Check that the function To_Ada raises Terminator_Error if the
 349          -- parameter Trim_Nul is set to True, but the actual Item parameter
 350          -- does not contain the nul char.
 351
 352          begin
 353             TC_String := To_Ada(TC_No_nul, Trim_Nul => True);
 354             Report.Failed("Terminator_Error not raised when Item "    &
 355                           "parameter of To_Ada does not contain the " &
 356                           "nul char, but parameter Trim_Nul => True");
 357             Report.Comment(TC_String & " printed to defeat optimization");
 358          exception
 359             when Terminator_Error => null;  -- OK, expected exception.
 360             when others           =>
 361                Report.Failed("Incorrect exception raised by function "  &
 362                              "To_Ada when the Item parameter does not " &
 363                              "contain the nul char, but parameter "     &
 364                              "Trim_Nul => True");
 365          end;
 366
 367       end;
 368
 369    exception
 370       when The_Error : others =>
 371          Report.Failed ("The following exception was raised in the " &
 372                         "Test_Block: " & Exception_Name(The_Error));
 373    end Test_Block;
 374
 375    Report.Result;
 376
 377 end CXB30041;