gcc/testsuite/ada/acats/tests/c2/c250001.aw

   1 -- C250001.AW
   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 wide character literals are supported.
  28 --      Check that wide character string literals are supported.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      This test utilizes the brackets scheme for representing wide character
  32 --      values in transportable 7 bit ASCII as proposed by Robert Dewar;
  33 --      this test defines Wide_Character and Wide_String objects, and assigns
  34 --      and tests several sample values.
  35 --
  36 -- SPECIAL REQUIREMENTS:
  37 --
  38 --      This file must be preprocessed before it can be executed as a test.
  39 --
  40 --      This test requires that all occurrences of the bracket escape
  41 --      representation for wide characters be replaced, as appropriate, with
  42 --      the corresponding wide character as represented by the implementation.
  43 --
  44 --      Characters above ASCII.Del are represented by an 8 character sequence:
  45 --
  46 --          ["xxxx"]
  47 --
  48 --      where the character code represented is specified by four hexadecimal
  49 --      digits, (<xxxx>) upper case. For example the wide character with the
  50 --      code 16#ABCD# is represented by the eight character sequence:
  51 --
  52 --          ["ABCD"]
  53 --
  54 --      The following function documents the translation algorithm:
  55 --
  56 --     function To_Wide( S:String ) return Wide_character is
  57 --       Numerical : Natural := 0;
  58 --       type Xlate is array(Character range '0'..'F') of Natural;
  59 --       Xlation : Xlate
  60 --               := ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
  61 --                   '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
  62 --                   'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
  63 --                   'F' => 15,  others => 0 );
  64 --     begin
  65 --       for I in S'Range loop
  66 --         Numerical := Numerical * 16 + Xlation(S(I));
  67 --       end loop;
  68 --       return Wide_Character'Val(Numerical);  -- the returned value is
  69 --                                   implementation dependent
  70 --     exception
  71 --       when Constraint_Error => raise;
  72 --     end To_Wide;
  73 --
  74 --
  75 -- CHANGE HISTORY:
  76 --      26 OCT 95   SAIC   Initial .Aversion
  77 --      11 APR 96   SAIC   Minor robustness changes for 2.1
  78 --      12 NOV 96   SAIC   Changed file extension to .AW
  79 --
  80 --!
  81
  82 ----------------------------------------------------------------- C250001_0
  83
  84 package C250001_0 is
  85
  86   -- The wide characters used in this test are sequential starting with
  87   -- the character '["4F42"]' 16#0F42#
  88
  89   Four_Eff_Four_Two : constant Wide_Character := '["4F42"]';
  90
  91   Four_Eff_4_3_Through_9 : constant Wide_String :=
  92                "["4F43"]["4F44"]["4F45"]["4F46"]["4F47"]["4F48"]["4F49"]";
  93
  94   Four_Eff_A_B : constant Wide_String := "["4F4A"]["4F4B"]";
  95
  96 end C250001_0;
  97
  98 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
  99
 100 -- no package body C250001_0 is required or allowed
 101
 102 ------------------------------------------------------------------- C250001
 103
 104 with Report;
 105 with C250001_0;
 106 with Ada.Tags;
 107
 108 procedure C250001 is
 109   use C250001_0;
 110
 111   function Hex( N: Natural ) return String is
 112     S : String := "xxxx";
 113     T : String := "0123456789ABCDEF";
 114     V : Natural := N;
 115   begin
 116     for I in reverse 1..4 loop
 117       S(I) := T(V rem 16 +1);
 118       V := V / 16;
 119     end loop;
 120     return S;
 121   end Hex;
 122
 123   procedure Match( Check : Wide_Character; Matching : Natural ) is
 124   begin
 125     if Wide_Character'Pos( Check ) /= Matching then
 126       Report.Failed( "Didn't match for " & Hex(Matching) );
 127     end if;
 128   end Match;
 129
 130   type Value_List is array(Positive range <>) of Natural;
 131
 132   procedure Match( Check : Wide_String; Matching : Value_List ) is
 133   begin
 134     if Check'Length /= Matching'Length then
 135       Report.Failed( "Check'Length /= Matching'Length" );
 136     else
 137       for I in Check'Range loop
 138         Match( Check(I), Matching(I) );
 139       end loop;
 140     end if;
 141   end Match;
 142
 143 begin  -- Main test procedure.
 144
 145   Report.Test ("C250001", "Check that wide character literals " &
 146                           "are supported.  Check that wide character " &
 147                           "string literals are supported." );
 148
 149   Match( Four_Eff_Four_Two, 16#4F42# );
 150
 151   Match(Four_Eff_4_3_Through_9,
 152          (16#4F43#,16#4F44#,16#4F45#,16#4F46#,16#4F47#,16#4F48#,16#4F49#) );
 153
 154  -- check catenations
 155
 156   Match( Four_Eff_Four_Two & Four_Eff_Four_Two, (16#4F42#,16#4F42#) );
 157
 158   Match( Four_Eff_Four_Two & Four_Eff_A_B, (16#4F42#,16#4F4A#,16#4F4B#) );
 159
 160   Match( Four_Eff_A_B & Four_Eff_Four_Two, (16#4F4A#,16#4F4B#,16#4F42#) );
 161
 162   Match( Four_Eff_A_B & Four_Eff_A_B,
 163          (16#4F4A#,16#4F4B#,16#4F4A#,16#4F4B#) );
 164
 165   Report.Result;
 166
 167 end C250001;