old-autovect-branch/gcc/testsuite/ada/acats/tests/cxb/cxb5002.a

   1 -- CXB5002.A
   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_Fortran with a Character parameter will
  28 --      return the corresponding Fortran Character_Set value.
  29 --
  30 --      Check that the Function To_Ada with a Character_Set parameter will
  31 --      return the corresponding Ada Character value.
  32 --
  33 --      Check that the Function To_Fortran with a String parameter will
  34 --      return the corresponding Fortran_Character value.
  35 --
  36 --      Check that the Function To_Ada with a Fortran_Character parameter
  37 --      will return the corresponding Ada String value.
  38 --
  39 -- TEST DESCRIPTION:
  40 --      This test checks that the functions To_Fortran and To_Ada produce
  41 --      the correct results, based on a variety of parameter input values.
  42 --
  43 --      In the first series of subtests, the results of the function
  44 --      To_Fortran are compared against expected Character_Set type results.
  45 --      In the second series of subtests, the results of the function To_Ada
  46 --      are compared against expected String type results, and the length of
  47 --      the String result is also verified against the Fortran_Character type
  48 --      parameter.
  49 --
  50 --      This test uses Fixed, Bounded, and Unbounded_Strings in combination
  51 --      with the functions under validation.
  52 --
  53 --      This test assumes that the following characters are all included
  54 --      in the implementation defined type Interfaces.Fortran.Character_Set:
  55 --      ' ', 'a'..'z', 'A'..'Z', '1'..'9', '-', '_', '$', '#', and '*'.
  56 --
  57 -- APPLICABILITY CRITERIA:
  58 --      This test is applicable to all implementations that provide
  59 --      package Interfaces.Fortran.  If an implementation provides
  60 --      package Interfaces.Fortran, this test must compile, execute, and
  61 --      report "PASSED".
  62 --
  63 --      This test does not apply to an implementation in which the Fortran
  64 --      character set ranges are not contiguous (e.g., EBCDIC).
  65 --
  66 --
  67 --
  68 -- CHANGE HISTORY:
  69 --      11 Mar 96   SAIC    Initial release for 2.1.
  70 --      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
  71 --      27 Oct 96   SAIC    Incorporated reviewer comments.
  72 --
  73 --!
  74
  75 with Ada.Characters.Latin_1;
  76 with Ada.Exceptions;
  77 with Ada.Strings.Bounded;
  78 with Ada.Strings.Unbounded;
  79 with Ada.Unchecked_Conversion;
  80 with Interfaces.Fortran;                                      -- N/A => ERROR
  81 with Report;
  82
  83 procedure CXB5002 is
  84 begin
  85
  86    Report.Test ("CXB5002", "Check that functions To_Fortran and To_Ada " &
  87                            "produce correct results");
  88
  89    Test_Block:
  90    declare
  91
  92       package ACL renames Ada.Characters.Latin_1;
  93       package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
  94       package Unb renames Ada.Strings.Unbounded;
  95
  96       use Bnd, Unb;
  97       use Interfaces.Fortran;
  98       use Ada.Exceptions;
  99
 100       Null_Fortran_Character  : constant Fortran_Character := "";
 101       Fortran_Character_1     : Fortran_Character(1..1)    := " ";
 102       Fortran_Character_5     : Fortran_Character(1..5)    := "     ";
 103       Fortran_Character_10    : Fortran_Character(1..10)   := "          ";
 104       Fortran_Character_20    : Fortran_Character(1..20)   :=
 105                                   "                    ";
 106       TC_Fortran_Character_1  : Fortran_Character(1..1)    := "A";
 107       TC_Fortran_Character_5  : Fortran_Character(1..5)    := "ab*de";
 108       TC_Fortran_Character_10 : Fortran_Character(1..10)   := "$1a2b3C4D5";
 109       TC_Fortran_Character_20 : Fortran_Character(1..20)   :=
 110                                   "1234-ABCD_6789#fghij";
 111
 112       Bnd_String              : Bnd.Bounded_String   :=
 113                                   Bnd.To_Bounded_String("          ");
 114       TC_Bnd_String           : Bounded_String       :=
 115                                   To_Bounded_String("$1a2b3C4D5");
 116
 117       Unb_String              : Unb.Unbounded_String :=
 118                                   Unb.To_Unbounded_String("     ");
 119       TC_Unb_String           : Unbounded_String     :=
 120                                   To_Unbounded_String("ab*de");
 121
 122       String_1                : String(1..1)    := " ";
 123       String_5                : String(1..5)    := "     ";
 124       String_10               : String(1..10)   := "          ";
 125       String_20               : String(1..20)   := "                    ";
 126       TC_String_1             : String(1..1)    := "A";
 127       TC_String_20            : String(1..20)   := "1234-ABCD_6789#fghij";
 128       Null_String             : constant String := "";
 129
 130       Null_Character          : constant Character := ACL.Nul;
 131       Character_A             : constant Character := Character'Val(65);
 132       Character_Z             : constant Character := Character'Val(90);
 133       TC_Character            : Character          := Character'First;
 134
 135       Null_Character_Set      : Character_Set      := To_Fortran(ACL.Nul);
 136       TC_Character_Set,
 137       TC_Low_Character_Set,
 138       TC_High_Character_Set   : Character_Set      := Character_Set'First;
 139
 140
 141       -- The following procedure checks the results of function To_Ada.
 142
 143       procedure Check_Length (Str : in String;
 144                               Ftn : in Fortran_Character;
 145                               Num : in Natural) is
 146       begin
 147          if Str'Length /= Ftn'Length or
 148             Str'Length /= Num
 149          then
 150             Report.Failed("Incorrect result from Function To_Ada " &
 151                           "with string length " & Integer'Image(Num));
 152          end if;
 153       end Check_Length;
 154
 155       -- To facilitate the conversion of Character-Character_Set data, the
 156       -- following functions have been instantiated.
 157
 158       function Character_to_Character_Set is
 159         new Ada.Unchecked_Conversion(Character, Character_Set);
 160
 161       function Character_Set_to_Character is
 162         new Ada.Unchecked_Conversion(Character_Set, Character);
 163
 164    begin
 165
 166       -- Check that the Function To_Fortran with a Character parameter
 167       -- will return the corresponding Fortran Character_Set value.
 168
 169       for TC_Character in ACL.LC_A..ACL.LC_Z loop
 170          if To_Fortran(Item => TC_Character) /=
 171             Character_to_Character_Set(TC_Character)
 172          then
 173             Report.Failed("Incorrect result from To_Fortran with lower " &
 174                           "case alphabetic character input");
 175          end if;
 176       end loop;
 177
 178       for TC_Character in Character_A..Character_Z loop
 179          if To_Fortran(TC_Character) /=
 180             Character_to_Character_Set(TC_Character)
 181          then
 182             Report.Failed("Incorrect result from To_Fortran with upper " &
 183                           "case alphabetic character input");
 184          end if;
 185       end loop;
 186
 187       if To_Fortran(Null_Character) /=
 188          Character_to_Character_Set(Null_Character)
 189       then
 190          Report.Failed
 191            ("Incorrect result from To_Fortran with null character input");
 192       end if;
 193
 194
 195       -- Check that the Function To_Ada with a Character_Set parameter
 196       -- will return the corresponding Ada Character value.
 197
 198       TC_Low_Character_Set  := Character_to_Character_Set('a');
 199       TC_High_Character_Set := Character_to_Character_Set('z');
 200       for TC_Character_Set in TC_Low_Character_Set..TC_High_Character_Set loop
 201          if To_Ada(Item => TC_Character_Set) /=
 202             Character_Set_to_Character(TC_Character_Set)
 203          then
 204             Report.Failed("Incorrect result from To_Ada with lower case " &
 205                           "alphabetic Character_Set input");
 206          end if;
 207       end loop;
 208
 209       TC_Low_Character_Set  := Character_to_Character_Set('A');
 210       TC_High_Character_Set := Character_to_Character_Set('Z');
 211       for TC_Character_Set in TC_Low_Character_Set..TC_High_Character_Set loop
 212          if To_Ada(TC_Character_Set) /=
 213             Character_Set_to_Character(TC_Character_Set)
 214          then
 215             Report.Failed("Incorrect result from To_Ada with upper case " &
 216                           "alphabetic Character_Set input");
 217          end if;
 218       end loop;
 219
 220       if To_Ada(Character_to_Character_Set(Null_Character)) /=
 221          Null_Character
 222       then
 223          Report.Failed("Incorrect result from To_Ada with a null " &
 224                        "Character_Set input");
 225       end if;
 226
 227
 228       -- Check that the Function To_Fortran with a String parameter
 229       -- will return the corresponding Fortran_Character value.
 230       -- Note: The type Fortran_Character is a character array type that
 231       --       corresponds to Ada type String.
 232
 233       Fortran_Character_1 := To_Fortran(Item => TC_String_1);
 234
 235       if Fortran_Character_1 /= TC_Fortran_Character_1 then
 236          Report.Failed("Incorrect result from procedure To_Fortran - 1");
 237       end if;
 238
 239       Fortran_Character_5 := To_Fortran(To_String(TC_Unb_String));
 240
 241       if Fortran_Character_5 /= TC_Fortran_Character_5 then
 242          Report.Failed("Incorrect result from procedure To_Fortran - 2");
 243       end if;
 244
 245       Fortran_Character_10 := To_Fortran(To_String(TC_Bnd_String));
 246
 247       if Fortran_Character_10 /= TC_Fortran_Character_10 then
 248          Report.Failed("Incorrect result from procedure To_Fortran - 3");
 249       end if;
 250
 251       Fortran_Character_20 := To_Fortran(Item => TC_String_20);
 252
 253       if Fortran_Character_20 /= TC_Fortran_Character_20 then
 254          Report.Failed("Incorrect result from procedure To_Fortran - 4");
 255       end if;
 256
 257       if To_Fortran(Null_String) /= Null_Fortran_Character then
 258          Report.Failed("Incorrect result from procedure To_Fortran - 5");
 259       end if;
 260
 261
 262       -- Check that the Function To_Ada with a Fortran_Character parameter
 263       -- will return the corresponding Ada String value.
 264
 265       String_1 := To_Ada(TC_Fortran_Character_1);
 266
 267       if String_1 /= TC_String_1 then
 268          Report.Failed("Incorrect value returned from function To_Ada - 1");
 269       end if;
 270
 271       Check_Length(To_Ada(TC_Fortran_Character_1),
 272                    TC_Fortran_Character_1,
 273                    Num => 1);
 274
 275
 276       Unb_String := Unb.To_Unbounded_String(To_Ada(TC_Fortran_Character_5));
 277
 278       if Unb_String /= TC_Unb_String then
 279          Report.Failed("Incorrect value returned from function To_Ada - 2");
 280       end if;
 281
 282       Check_Length(To_Ada(TC_Fortran_Character_5),
 283                    TC_Fortran_Character_5,
 284                    Num => 5);
 285
 286
 287       Bnd_String := Bnd.To_Bounded_String
 288                          (To_Ada(TC_Fortran_Character_10));
 289
 290       if Bnd_String /= TC_Bnd_String then
 291          Report.Failed("Incorrect value returned from function To_Ada - 3");
 292       end if;
 293
 294       Check_Length(To_Ada(TC_Fortran_Character_10),
 295                    TC_Fortran_Character_10,
 296                    Num => 10);
 297
 298
 299       String_20 := To_Ada(TC_Fortran_Character_20);
 300
 301       if String_20 /= TC_String_20 then
 302          Report.Failed("Incorrect value returned from function To_Ada - 4");
 303       end if;
 304
 305       Check_Length(To_Ada(TC_Fortran_Character_20),
 306                    TC_Fortran_Character_20,
 307                    Num => 20);
 308
 309       if To_Ada(Null_Character_Set) /= Null_Character then
 310          Report.Failed("Incorrect value returned from function To_Ada - 5");
 311       end if;
 312
 313
 314       -- Check the two functions when used in combination.
 315
 316       if To_Ada(Item => To_Fortran("This is a test")) /=
 317          "This is a test"                                or
 318          To_Ada(To_Fortran("1234567890abcdeFGHIJ"))   /=
 319          Report.Ident_Str("1234567890abcdeFGHIJ")
 320       then
 321          Report.Failed("Incorrect result returned when using the " &
 322                        "functions To_Ada and To_Fortran in combination");
 323       end if;
 324
 325
 326    exception
 327       when The_Error : others =>
 328          Report.Failed("The following exception was raised in the " &
 329                        "Test_Block: " & Exception_Name(The_Error));
 330    end Test_Block;
 331
 332    Report.Result;
 333
 334 end CXB5002;