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

   1 -- CXB4005.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_COBOL will convert a String
  28 --      parameter value into a type Alphanumeric array of
  29 --      COBOL_Characters, with lower bound of one, and length
  30 --      equal to length of the String parameter, based on the
  31 --      mapping Ada_to_COBOL.
  32 --
  33 --      Check that the function To_Ada will convert a type
  34 --      Alphanumeric parameter value into a String type result,
  35 --      with lower bound of one, and length equal to the length
  36 --      of the Alphanumeric parameter, based on the mapping
  37 --      COBOL_to_Ada.
  38 --
  39 --      Check that the Ada_to_COBOL and COBOL_to_Ada mapping
  40 --      arrays provide a mapping capability between Ada's type
  41 --      Character and COBOL run-time character sets.
  42 --
  43 -- TEST DESCRIPTION:
  44 --      This test checks that the functions To_COBOL and To_Ada produce
  45 --      the correct results, based on a variety of parameter input values.
  46 --
  47 --      In the first series of subtests, the results of the function
  48 --      To_COBOL are compared against expected Alphanumeric type results,
  49 --      and the length and lower bound of the alphanumeric result are
  50 --      also verified.  In the second series of subtests, the results of
  51 --      the function To_Ada are compared against expected String type
  52 --      results, and the length of the String result is also verified
  53 --      against the Alphanumeric type parameter.
  54 --
  55 --      This test also verifies that two mapping array variables defined
  56 --      in package Interfaces.COBOL, Ada_To_COBOL and COBOL_To_Ada, are
  57 --      available, and that they can be modified by a user at runtime.
  58 --      Finally, the effects of user modifications on these mapping
  59 --      variables is checked in the test.
  60 --
  61 --      This test uses Fixed, Bounded, and Unbounded_Strings in combination
  62 --      with the functions under validation.
  63 --
  64 --      This test assumes that the following characters are all included
  65 --      in the implementation defined type Interfaces.COBOL.COBOL_Character:
  66 --      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*', ',', '.', and '$'.
  67 --
  68 -- APPLICABILITY CRITERIA:
  69 --      This test is applicable to all implementations that provide
  70 --      package Interfaces.COBOL.  If an implementation provides
  71 --      package Interfaces.COBOL, this test must compile, execute, and
  72 --      report "PASSED".
  73 --
  74 --
  75 -- CHANGE HISTORY:
  76 --      11 Jan 96   SAIC    Initial prerelease version for ACVC 2.1
  77 --      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
  78 --      27 Oct 96   SAIC    Incorporated reviewer comments.
  79 --
  80 --!
  81
  82 with Report;
  83 with Ada.Exceptions;
  84 with Ada.Strings.Bounded;
  85 with Ada.Strings.Unbounded;
  86 with Interfaces.COBOL;                                          -- N/A => ERROR
  87
  88 procedure CXB4005 is
  89 begin
  90
  91    Report.Test ("CXB4005", "Check that the functions To_COBOL and " &
  92                            "To_Ada produce correct results");
  93
  94    Test_Block:
  95    declare
  96
  97       package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(5);
  98       package Unb renames Ada.Strings.Unbounded;
  99
 100       use Ada.Exceptions;
 101       use Interfaces;
 102       use Bnd;
 103       use type Unb.Unbounded_String;
 104       use type Interfaces.COBOL.Alphanumeric;
 105
 106       TC_Alphanumeric_1  : Interfaces.COBOL.Alphanumeric(1..1);
 107       TC_Alphanumeric_5  : Interfaces.COBOL.Alphanumeric(1..5);
 108       TC_Alphanumeric_10 : Interfaces.COBOL.Alphanumeric(1..10);
 109       TC_Alphanumeric_20 : Interfaces.COBOL.Alphanumeric(1..20);
 110
 111       Bnd_String,
 112       TC_Bnd_String      : Bnd.Bounded_String   :=
 113                              Bnd.To_Bounded_String("     ");
 114       Unb_String,
 115       TC_Unb_String      : Unb.Unbounded_String :=
 116                              Unb.To_Unbounded_String("                    ");
 117
 118       The_String,
 119       TC_String          : String(1..20) := ("                    ");
 120
 121    begin
 122
 123       -- Check that the function To_COBOL will convert a String
 124       -- parameter value into a type Alphanumeric array of
 125       -- COBOL_Characters, with lower bound of one, and length
 126       -- equal to length of the String parameter, based on the
 127       -- mapping Ada_to_COBOL.
 128
 129       Unb_String         := Unb.To_Unbounded_String("A");
 130       TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));
 131
 132       if TC_Alphanumeric_1        /= "A"                    or
 133          TC_Alphanumeric_1'Length /= Unb.Length(Unb_String) or
 134          TC_Alphanumeric_1'Length /= 1                      or
 135          COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
 136       then
 137          Report.Failed("Incorrect result from function To_COBOL - 1");
 138       end if;
 139
 140       Bnd_String         := Bnd.To_Bounded_String("abcde");
 141       TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));
 142
 143       if TC_Alphanumeric_5        /= "abcde"                or
 144          TC_Alphanumeric_5'Length /= Bnd.Length(Bnd_String) or
 145          TC_Alphanumeric_5'Length /= 5                      or
 146          COBOL.To_COBOL(Bnd.To_String(Bnd_String))'First  /= 1
 147       then
 148          Report.Failed("Incorrect result from function To_COBOL - 2");
 149       end if;
 150
 151       Unb_String         := Unb.To_Unbounded_String("1A2B3c4d5F");
 152       TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
 153
 154       if TC_Alphanumeric_10        /= "1A2B3c4d5F"           or
 155          TC_Alphanumeric_10'Length /= Unb.Length(Unb_String) or
 156          TC_Alphanumeric_10'Length /= 10                     or
 157          COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
 158       then
 159          Report.Failed("Incorrect result from function To_COBOL - 3");
 160       end if;
 161
 162       The_String         := "abcd  ghij" & "1234  7890";
 163       TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);
 164
 165       if TC_Alphanumeric_20                /= "abcd  ghij1234  7890" or
 166          TC_Alphanumeric_20'Length         /= The_String'Length      or
 167          TC_Alphanumeric_20'Length         /= 20                     or
 168          COBOL.To_COBOL(The_String)'First  /= 1
 169       then
 170          Report.Failed("Incorrect result from function To_COBOL - 4");
 171       end if;
 172
 173
 174
 175       -- Check that the function To_Ada will convert a type
 176       -- Alphanumeric parameter value into a String type result,
 177       -- with lower bound of one, and length equal to the length
 178       -- of the Alphanumeric parameter, based on the mapping
 179       -- COBOL_to_Ada.
 180
 181       TC_Unb_String := Unb.To_Unbounded_String
 182                          (COBOL.To_Ada(TC_Alphanumeric_1));
 183
 184       if TC_Unb_String             /= "A"                       or
 185          TC_Alphanumeric_1'Length  /= Unb.Length(TC_Unb_String) or
 186          Unb.Length(TC_Unb_String) /= 1                         or
 187          COBOL.To_Ada(TC_Alphanumeric_1)'First /= 1
 188       then
 189          Report.Failed("Incorrect value returned from function To_Ada - 1");
 190       end if;
 191
 192       TC_Bnd_String := Bnd.To_Bounded_String
 193                          (COBOL.To_Ada(TC_Alphanumeric_5));
 194
 195       if TC_Bnd_String             /= "abcde"                   or
 196          TC_Alphanumeric_5'Length  /= Bnd.Length(TC_Bnd_String) or
 197          Bnd.Length(TC_Bnd_String) /= 5                         or
 198          COBOL.To_Ada(TC_Alphanumeric_5)'First /= 1
 199       then
 200          Report.Failed("Incorrect value returned from function To_Ada - 2");
 201       end if;
 202
 203       TC_Unb_String := Unb.To_Unbounded_String
 204                          (COBOL.To_Ada(TC_Alphanumeric_10));
 205
 206       if TC_Unb_String             /= "1A2B3c4d5F"              or
 207          TC_Alphanumeric_10'Length /= Unb.Length(TC_Unb_String) or
 208          Unb.Length(TC_Unb_String) /= 10                        or
 209          COBOL.To_Ada(TC_Alphanumeric_10)'First /= 1
 210       then
 211          Report.Failed("Incorrect value returned from function To_Ada - 3");
 212       end if;
 213
 214       TC_String := COBOL.To_Ada(TC_Alphanumeric_20);
 215
 216       if TC_String                 /= "abcd  ghij1234  7890" or
 217          TC_Alphanumeric_20'Length /= TC_String'Length       or
 218          TC_String'Length          /= 20                     or
 219          COBOL.To_Ada(TC_Alphanumeric_20)'First /= 1
 220       then
 221          Report.Failed("Incorrect value returned from function To_Ada - 4");
 222       end if;
 223
 224
 225       -- Check the two functions when used in combination.
 226
 227       if COBOL.To_COBOL(Item => COBOL.To_Ada("This is a test")) /=
 228          "This is a test"                                         or
 229          COBOL.To_COBOL(COBOL.To_Ada("1234567890abcdeFGHIJ"))   /=
 230          "1234567890abcdeFGHIJ"
 231       then
 232          Report.Failed("Incorrect result returned when using the " &
 233                        "functions To_Ada and To_COBOL in combination");
 234       end if;
 235
 236
 237
 238       -- Check that the Ada_to_COBOL and COBOL_to_Ada mapping
 239       -- arrays provide a mapping capability between Ada's type
 240       -- Character and COBOL run-time character sets.
 241
 242       Interfaces.COBOL.Ada_To_COBOL('a') := 'A';
 243       Interfaces.COBOL.Ada_To_COBOL('b') := 'B';
 244       Interfaces.COBOL.Ada_To_COBOL('c') := 'C';
 245       Interfaces.COBOL.Ada_To_COBOL('d') := '1';
 246       Interfaces.COBOL.Ada_To_COBOL('e') := '2';
 247       Interfaces.COBOL.Ada_To_COBOL('f') := '3';
 248       Interfaces.COBOL.Ada_To_COBOL(' ') := '*';
 249
 250       Unb_String         := Unb.To_Unbounded_String("b");
 251       TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));
 252
 253       if TC_Alphanumeric_1 /= "B" then
 254          Report.Failed("Incorrect result from function To_COBOL after " &
 255                        "modification to Ada_To_COBOL mapping array - 1");
 256       end if;
 257
 258       Bnd_String         := Bnd.To_Bounded_String("abcde");
 259       TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));
 260
 261       if TC_Alphanumeric_5 /= "ABC12" then
 262          Report.Failed("Incorrect result from function To_COBOL after " &
 263                        "modification to Ada_To_COBOL mapping array - 2");
 264       end if;
 265
 266       Unb_String         := Unb.To_Unbounded_String("1a2B3c4d5e");
 267       TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
 268
 269       if TC_Alphanumeric_10 /= "1A2B3C4152" then
 270          Report.Failed("Incorrect result from function To_COBOL after " &
 271                        "modification to Ada_To_COBOL mapping array - 3");
 272       end if;
 273
 274       The_String         := "abcd  ghij" & "1234  7890";
 275       TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);
 276
 277       if TC_Alphanumeric_20 /= "ABC1**ghij1234**7890" then
 278          Report.Failed("Incorrect result from function To_COBOL after " &
 279                        "modification to Ada_To_COBOL mapping array - 4");
 280       end if;
 281
 282
 283       -- Reset the Ada_To_COBOL mapping array to its original state.
 284
 285       Interfaces.COBOL.Ada_To_COBOL('a') := 'a';
 286       Interfaces.COBOL.Ada_To_COBOL('b') := 'b';
 287       Interfaces.COBOL.Ada_To_COBOL('c') := 'c';
 288       Interfaces.COBOL.Ada_To_COBOL('d') := 'd';
 289       Interfaces.COBOL.Ada_To_COBOL('e') := 'e';
 290       Interfaces.COBOL.Ada_To_COBOL('f') := 'f';
 291       Interfaces.COBOL.Ada_To_COBOL(' ') := ' ';
 292
 293       -- Modify the COBOL_To_Ada mapping array to check its effect on
 294       -- the function To_Ada.
 295
 296       Interfaces.COBOL.COBOL_To_Ada(' ') := '*';
 297       Interfaces.COBOL.COBOL_To_Ada('$') := 'F';
 298       Interfaces.COBOL.COBOL_To_Ada('1') := '7';
 299       Interfaces.COBOL.COBOL_To_Ada('.') := ',';
 300
 301       Unb_String         := Unb.To_Unbounded_String("  $$100.00");
 302       TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
 303       TC_Unb_String      := Unb.To_Unbounded_String(
 304                               COBOL.To_Ada(TC_Alphanumeric_10));
 305
 306       if Unb.To_String(TC_Unb_String) /= "**FF700,00" then
 307          Report.Failed("Incorrect result from function To_Ada after " &
 308                        "modification of COBOL_To_Ada mapping array - 1");
 309       end if;
 310
 311       Interfaces.COBOL.COBOL_To_Ada('*') := ' ';
 312       Interfaces.COBOL.COBOL_To_Ada('F') := '$';
 313       Interfaces.COBOL.COBOL_To_Ada('7') := '1';
 314       Interfaces.COBOL.COBOL_To_Ada(',') := '.';
 315
 316       if COBOL.To_Ada(COBOL.To_COBOL(Unb.To_String(TC_Unb_String))) /=
 317          Unb_String
 318       then
 319          Report.Failed("Incorrect result from function To_Ada after " &
 320                        "modification of COBOL_To_Ada mapping array - 2");
 321       end if;
 322
 323
 324    exception
 325       when The_Error : others =>
 326          Report.Failed ("The following exception was raised in the " &
 327                         "Test_Block: " & Exception_Name(The_Error));
 328    end Test_Block;
 329
 330    Report.Result;
 331
 332 end CXB4005;