cxa4018.a

用于进行gcc测试

-- CXA4018.A
--
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
--      Check that the subprograms defined in package 
--      Ada.Strings.Wide_Bounded are available, and that they produce 
--      correct results. Specifically, check the subprograms Append, 
--      Count, Element, Find_Token, Head, Index_Non_Blank, Replace_Element, 
--      Replicate, Tail, To_Bounded_Wide_String, "&", ">", "<", ">=", "<=", 
--      and "*".
--      
-- TEST DESCRIPTION:
--      This test, when taken in conjunction with test CXA40[17,19,20], will 
--      constitute a test of all the functionality contained in package
--      Ada.Strings.Wide_Bounded.  This test uses a variety of the
--      subprograms defined in the wide bounded string package in ways typical
--      of common usage.  Different combinations of available subprograms
--      are used to accomplish similar wide bounded string processing goals.
--
--      
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      22 Dec 94   SAIC    Changed obsolete constant to Strings.Wide_Space.
--      06 Nov 95   SAIC    Corrected evaluation string used in Head/Tail
--                          subtests for ACVC 2.0.1.
--
--!

with Ada.Strings;
with Ada.Strings.Wide_Bounded;
with Ada.Characters.Handling;
with Ada.Strings.Wide_Maps;
with Report;

procedure CXA4018 is

   -- The following two functions are used to translate character and string
   -- values to "Wide" values.  They will be applied to all the Wide_Bounded
   -- subprogram parameters to simulate the use of Wide_Characters and 
   -- Wide_Strings in actual practice. Blanks are translated to Wide_Character
   -- blanks and all other characters are translated into Wide_Characters with
   -- position values 256 greater than their (narrow) character position
   -- values.

   function Translate (Ch : Character) return Wide_Character is
      C : Character := Ch;
   begin
      if Ch = ' ' then
         return Ada.Characters.Handling.To_Wide_Character(C);
      else
         return Wide_Character'Val(Character'Pos(Ch) + 
                                   Character'Pos(Character'Last) + 1);
      end if;
   end Translate;

   function Translate (Str : String) return Wide_String is
      WS : Wide_String(Str'First..Str'Last);
   begin
      for i in Str'First..Str'Last loop
         WS(i) := Translate(Str(i));
      end loop;
      return WS;
   end Translate;


begin

   Report.Test ("CXA4018", "Check that the subprograms defined in package " &
                           "Ada.Strings.Wide_Bounded are available, and "   &
                           "that they produce correct results");

   Test_Block:
   declare

      package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80);
      use type BS80.Bounded_Wide_String;

      Part1 : constant Wide_String     := Translate("Rum");
      Part2 : Wide_Character           := Translate('p');
      Part3 : BS80.Bounded_Wide_String := 
                BS80.To_Bounded_Wide_String(Translate("el"));
      Part4 : Wide_Character           := Translate('s');
      Part5 : BS80.Bounded_Wide_String := 
                BS80.To_Bounded_Wide_String(Translate("tilt"));
      Part6 : Wide_String(1..3)        := Translate("ski");

      Full_Catenate_String,
      Full_Append_String,  
      Constructed_String,   
      Drop_String,
      Replicated_String,     
      Token_String         : BS80.Bounded_Wide_String;

      CharA : Wide_Character := Translate('A');
      CharB : Wide_Character := Translate('B');
      CharC : Wide_Character := Translate('C');
      CharD : Wide_Character := Translate('D');
      CharE : Wide_Character := Translate('E');
      CharF : Wide_Character := Translate('F');

      ABStr : Wide_String(1..15) := Translate("AAAAABBBBBBBBBB");
      StrB  : Wide_String(1..2)  := Translate("BB");
      StrE  : Wide_String(1..2)  := Translate("EE");


   begin

      -- Evaluation of the overloaded forms of the "&" operator.

      Full_Catenate_String := 
        BS80."&"(Part2,                            -- WChar & Bnd WStr
                 BS80."&"(Part3,                   -- Bnd WStr & Bnd WStr
                          BS80."&"(Part4,          -- WChar & Bnd WStr
                                   BS80."&"(Part5, -- Bnd WStr & Bnd WStr
                                            BS80.To_Bounded_Wide_String
                                              (Part6)))));  
                                                 
      Full_Catenate_String := 
        BS80."&"(Part1, Full_Catenate_String);     -- WStr & Bnd WStr
      Full_Catenate_String := 
        BS80."&"(Left  => Full_Catenate_String, 
                 Right => Translate('n'));         -- Bnd WStr & WChar


      -- Evaluation of the overloaded forms of function Append.

      Full_Append_String := 
        BS80.Append(Part2,                               -- WChar,Bnd WStr
          BS80.Append(Part3,                             -- Bnd WStr, Bnd WStr
            BS80.Append(Part4,                           -- WChar,Bnd WStr
              BS80.Append(BS80.To_Wide_String(Part5),    -- WStr,Bnd WStr
                BS80.To_Bounded_Wide_String(Part6)))));

      Full_Append_String := 
        BS80.Append(BS80.To_Bounded_Wide_String(Part1),  -- Bnd WStr, WStr
                    BS80.To_Wide_String(Full_Append_String));

      Full_Append_String := 
        BS80.Append(Left  => Full_Append_String, 
                    Right => Translate('n'));             -- Bnd WStr, WChar


      -- Validate the resulting bounded wide strings.

      if BS80."<"(Full_Catenate_String, Full_Append_String) or
         BS80.">"(Full_Catenate_String, Full_Append_String) or
         not (Full_Catenate_String  = Full_Append_String and
              BS80."<="(Full_Catenate_String, Full_Append_String) and
              BS80.">="(Full_Catenate_String, Full_Append_String))
      then
         Report.Failed
           ("Incorrect results from bounded wide string catenation" &
            " and comparison");
      end if;


      -- Evaluate the overloaded forms of the Constructor function "*" and 
      -- the Replicate function.

      Constructed_String := 
        BS80."*"(2,CharA) &                     -- "AA"
        BS80."*"(2,StrB) &                      -- "AABBBB"
        BS80."*"(3, BS80."*"(2, CharC)) &       -- "AABBBBCCCCCC"
        BS80.Replicate(3, 
                   BS80.Replicate(2, CharD)) &  -- "AABBBBCCCCCCDDDDDD"
        BS80.Replicate(2, StrE) &               -- "AABBBBCCCCCCDDDDDDEEEE"
        BS80.Replicate(2, CharF);               -- "AABBBBCCCCCCDDDDDDEEEEFF"