cxa4020.a

Mac OS X 10.4.9 for x86 Source Code gcc 实现源代码

-- CXA4020.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, especially under
--      conditions where truncation of the result is required.  Specifically, 
--      check the subprograms Overwrite (function and procedure), Delete,
--      Function Trim (blanks), Trim (Set wide characters, function and
--      procedure), Head, Tail, and Replicate (wide characters and wide 
--      strings).
--
-- TEST DESCRIPTION:
--      This test, in conjunction with tests CXA4017, CXA4018, CXA4019, 
--      will provide coverage of the most common usages of the functionality
--      found in the Ada.Strings.Wide_Bounded package.  It deals in large part
--      with truncation effects and options.  This test contains many small, 
--      specific test cases, situations that are often difficult to generate 
--      in large numbers in an application-based test.  These cases represent 
--      specific usage paradigms in-the-small.
--
--       
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      22 Dec 94   SAIC    Changed obsolete constant to Strings.Wide_Space.
--      13 Apr 95   SAIC    Corrected certain subtest acceptance conditions.
--
--!

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

procedure CXA4020 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("CXA4020", "Check that the subprograms defined in "      &
                          "package Ada.Strings.Wide_Bounded are "       &
                          "available, and that they produce correct "   &
                          "results, especially under conditions where " &
                          "truncation of the result is required");

   Test_Block:
   declare

      package AS   renames Ada.Strings;
      package ASW  renames Ada.Strings.Wide_Bounded;
      package Maps renames Ada.Strings.Wide_Maps;

      package B10 is new ASW.Generic_Bounded_Length(Max => 10);
      use type B10.Bounded_Wide_String;

      Result_String : B10.Bounded_Wide_String;
      Test_String   : B10.Bounded_Wide_String;
      AtoE_Bnd_Str  : B10.Bounded_Wide_String := 
                        B10.To_Bounded_Wide_String(Translate("abcde"));
      FtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
                        B10.To_Bounded_Wide_String(Translate("fghij"));
      AtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
                        B10.To_Bounded_Wide_String(Translate("abcdefghij"));

      Location     : Natural := 0;
      Total_Count  : Natural := 0;

      CD_Set       : Maps.Wide_Character_Set := Maps.To_Set(Translate("cd")); 
      XY_Set       : Maps.Wide_Character_Set := Maps.To_Set(Translate("xy")); 


   begin

      -- Function Overwrite with Truncation                  
      -- Drop = Error (Default).

      begin
         Test_String   := AtoJ_Bnd_Str;
         Result_String := 
           B10.Overwrite(Source   => Test_String, -- "abcdefghij"
                         Position => 9,
                         New_Item => Translate("xyz"),
                         Drop     => AS.Error);
         Report.Failed("Exception not raised by Function Overwrite");
      exception
         when AS.Length_Error => null;  -- Expected exception raised.
         when others          => 
           Report.Failed("Incorrect exception raised by Function Overwrite");
      end;

      -- Drop = Left
 
      Result_String :=
        B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
                      Position => B10.Length(Test_String), -- 10
                      New_Item => Translate("xyz"),
                      Drop     => Ada.Strings.Left);

      if B10.To_Wide_String(Result_String) /= 
         Translate("cdefghixyz") then   -- drop a,b
         Report.Failed
           ("Incorrect result from Function Overwrite, Drop = Left");
      end if;

      -- Drop = Right

      Result_String := B10.Overwrite(Test_String,  -- "abcdefghij"
                                     3,
                                     Translate("xxxyyyzzz"),
                                     Ada.Strings.Right);

      if B10.To_Wide_String(Result_String) /= 
         Translate("abxxxyyyzz") 
      then
         Report.Failed
           ("Incorrect result from Function Overwrite, Drop = Right");
      end if;

      -- Additional cases of function Overwrite.

      if B10.Overwrite(B10.To_Bounded_Wide_String(Translate("a")),      
                       1,                                 -- Source length = 1
                       Translate("  abc  "))              /= 
         B10.To_Bounded_Wide_String(Translate("  abc  "))       or
         B10.Overwrite(B10.Null_Bounded_Wide_String,      -- Null source
                       1, 
                       Translate("abcdefghij"))           /=
         AtoJ_Bnd_Str                                or
         B10.Overwrite(AtoE_Bnd_Str, 
                       B10.To_Wide_String(AtoE_Bnd_Str)'First,
                       Translate(" "))                    /=  -- New_Item = 1
         B10.To_Bounded_Wide_String(Translate(" bcde"))
      then
         Report.Failed("Incorrect result from Function Overwrite");
      end if;



      -- Procedure Overwrite                                 
      -- Correct usage, no truncation.

      Test_String := AtoE_Bnd_Str;   -- "abcde"
      B10.Overwrite(Test_String, 2, Translate("xyz"));

      if Test_String /= B10.To_Bounded_Wide_String(Translate("axyze")) then
         Report.Failed("Incorrect result from Procedure Overwrite - 1");
      end if;

      Test_String := B10.To_Bounded_Wide_String(Translate("abc"));
      B10.Overwrite(Test_String, 2, "");   -- New_Item is null string.

      if Test_String /= B10.To_Bounded_Wide_String(Translate("abc")) then
         Report.Failed("Incorrect result from Procedure Overwrite - 2");
      end if;

      -- Drop = Error (Default).

      begin
         Test_String   := AtoJ_Bnd_Str;
         B10.Overwrite(Source   => Test_String, -- "abcdefghij"
                       Position => 8,
                       New_Item => Translate("uvwxyz"));
         Report.Failed("Exception not raised by Procedure Overwrite");
      exception
         when AS.Length_Error => null;  -- Expected exception raised.
         when others          => 
           Report.Failed("Incorrect exception raised by Procedure Overwrite");
      end;

      -- Drop = Left
 
      Test_String   := AtoJ_Bnd_Str;
      B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
                    Position => B10.Length(Test_String) - 2, -- 8
                    New_Item => Translate("uvwxyz"),
                    Drop     => Ada.Strings.Left);

      if B10.To_Wide_String(Test_String) /= 
         Translate("defguvwxyz")
      then  
         Report.Failed
           ("Incorrect result from Procedure Overwrite, Drop = Left");
      end if;

      -- Drop = Right

      Test_String   := AtoJ_Bnd_Str;
      B10.Overwrite(Test_String,  -- "abcdefghij"
                    3,
                    Translate("xxxyyyzzz"),
                    Ada.Strings.Right);

      if B10.To_Wide_String(Test_String) /= Translate("abxxxyyyzz") then
         Report.Failed                                         
           ("Incorrect result from Procedure Overwrite, Drop = Right");
      end if;



      -- Function Delete                                     

      if B10.Delete(Source  => AtoJ_Bnd_Str,   -- "abcdefghij"
                    From    => 3,
                    Through => 8)                               /=
         B10."&"(B10.Head(AtoJ_Bnd_Str, 2), 
                 B10.Tail(AtoJ_Bnd_Str, 2))                         or
         B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str))  /=
         AtoE_Bnd_Str                                               or
         B10.Delete(AtoJ_Bnd_Str, 1, 5)                         /= 
         FtoJ_Bnd_Str                                               
      then
         Report.Failed("Incorrect result from Function Delete - 1");
      end if;

      if B10.Delete(B10.To_Bounded_Wide_String(Translate("a")), 1, 1)  /= 
         B10.Null_Bounded_Wide_String                                    or
         B10.Delete(AtoE_Bnd_Str, 
                    5, 
                    B10.To_Wide_String(AtoE_Bnd_Str)'First) /=
         AtoE_Bnd_Str                                           or
         B10.Delete(AtoE_Bnd_Str,
                    B10.To_Wide_String(AtoE_Bnd_Str)'Last,
                    B10.To_Wide_String(AtoE_Bnd_Str)'Last)  /=
         B10.To_Bounded_Wide_String(Translate("abcd"))
      then
         Report.Failed("Incorrect result from Function Delete - 2");
      end if;
      


      -- Function Trim

      declare

         Text : B10.Bounded_Wide_String := 
                  B10.To_Bounded_Wide_String(Translate("Text"));
         type Bnd_Array_Type is array (1..5) of B10.Bounded_Wide_String;
         Bnd_Array : Bnd_Array_Type :=
           (B10.To_Bounded_Wide_String(Translate("  Text")),
            B10.To_Bounded_Wide_String(Translate("Text    ")),
            B10.To_Bounded_Wide_String(Translate("   Text   ")),
            B10.To_Bounded_Wide_String(Translate("Text  Text")),
            B10.To_Bounded_Wide_String(Translate(" Text Text")));

      begin

         for i in Bnd_Array_Type'Range loop
            case i is
               when 4 =>
                  if B10.Trim(Bnd_Array(i), AS.Both) /= 
                     Bnd_Array(i) then  -- no change
                     Report.Failed("Incorrect result from Function Trim - 4");
                  end if;
               when 5 =>
                  if B10.Trim(Bnd_Array(i), AS.Both) /= 
                     B10."&"(Text, B10."&"(Translate(' '), Text)) 
                  then
                     Report.Failed("Incorrect result from Function Trim - 5");
                  end if;
               when others =>
                  if B10.Trim(Bnd_Array(i), AS.Both) /= Text then
                     Report.Failed("Incorrect result from Function Trim - " &
                                    Integer'Image(i));
                  end if;
            end case;
         end loop;

      end;



      -- Function Trim using Sets                            

      -- Trim characters in sets from both sides of the bounded wide string.
      if B10.Trim(Source => B10.To_Bounded_Wide_String(Translate("ddabbaxx")),
                  Left   => CD_Set,
                  Right  => XY_Set)  /=
         B10.To_Bounded_Wide_String(Translate("abba"))
      then
         Report.Failed
           ("Incorrect result from Fn Trim - Sets, Left & Right side - 1");
      end if;

      -- Ensure that the characters in the set provided as the actual to
      -- parameter Right are not trimmed from the left side of the bounded
      -- wide string; likewise for the opposite side.  Only "cd" trimmed 
      -- from left side, and only "xy" trimmed from right side.

      if B10.Trim(B10.To_Bounded_Wide_String(Translate("cdxyabcdxy")), 
                  CD_Set, 
                  XY_Set) /=
         B10.To_Bounded_Wide_String(Translate("xyabcd"))
      then
         Report.Failed