cxa4019.a

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

-- CXA4019.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 Append, Count with non-Identity
--      maps, Index with non-Identity maps, Index with Set parameters, 
--      Insert (function and procedure), Replace_Slice (function and 
--      procedure), To_Bounded_Wide_String, and Translate (function and 
--      procedure).
--
-- TEST DESCRIPTION:
--      This test, in conjunction with tests CXA4017, CXA4018, and CXA4020, 
--      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
--      06 Nov 95   SAIC    Corrected expected result string in subtest for
--                          ACVC 2.0.1.
--                          Moved function Dog_to_Cat_Mapping to library
--                          level to correct accessibility problem in test.
--      22 Aug 96   SAIC    Corrected three subtests identified in reviewer
--                          comments.
--      17 Feb 97   PWB.CTA Corrected result strings for Translate and Insert
--
--!

package CXA40190 is

   -- Wide Character mapping function defined for use with specific 
   -- versions of functions Index and Count.

   function Dog_to_Cat_Mapping (From : Wide_Character) 
        return Wide_Character;

end CXA40190;

package body CXA40190 is

   -- Translates "dog" to "cat".
   function Dog_to_Cat_Mapping (From : Wide_Character) 
     return Wide_Character is
   begin
      if From = 'd' then
         return 'c';
      elsif From = 'o' then
         return 'a';
      elsif From = 'g' then
         return 't';
      else
         return From;
      end if;
   end Dog_to_Cat_Mapping;

end CXA40190;


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

procedure CXA4019 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.

   function Equiv (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 Equiv;


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

begin

   Report.Test("CXA4019", "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

      use CXA40190;

      package AS   renames Ada.Strings;
      package ASB  renames Ada.Strings.Wide_Bounded;
      package ASWC renames Ada.Strings.Wide_Maps.Wide_Constants;
      package Maps renames Ada.Strings.Wide_Maps;

      package B10 is new ASB.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(Equiv("abcde"));
      FtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
                        B10.To_Bounded_Wide_String(Equiv("fghij"));
      AtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
                        B10.To_Bounded_Wide_String(Equiv("abcdefghij"));

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

      CD_Set       : Maps.Wide_Character_Set := Maps.To_Set("cd"); 
      Wide_CD_Set  : Maps.Wide_Character_Set := Maps.To_Set(Equiv("cd")); 

      AB_to_YZ_Map : Maps.Wide_Character_Mapping :=
                     Maps.To_Mapping(From => "ab", To => "yz");

      Wide_AB_to_YZ_Map : Maps.Wide_Character_Mapping :=
                          Maps.To_Mapping(From => Equiv("ab"),  
                                          To   => Equiv("yz"));

      CD_to_XY_Map : Maps.Wide_Character_Mapping :=
                       Maps.To_Mapping(From => "cd", To => "xy");

      Wide_CD_to_XY_Map : Maps.Wide_Character_Mapping :=
                          Maps.To_Mapping(From => Equiv("cd"),  
                                          To   => Equiv("xy"));


      -- Access-to-Subprogram object defined for use with specific versions of 
      -- functions Index, Count Translate, and procedure Translate.

      Map_Ptr : Maps.Wide_Character_Mapping_Function := 
                  Dog_to_Cat_Mapping'Access;



   begin

      -- Function To_Bounded_Wide_String with Truncation 
      -- Evaluate the function Append with parameters that will 
      -- cause the truncation of the result.

      -- Drop = Error (default case, Length_Error will be raised)

      begin
         Test_String := 
           B10.To_Bounded_Wide_String
             (Equiv("Much too long for this bounded wide string"));
         Report.Failed("Length Error not raised by To_Bounded_Wide_String");
      exception
         when AS.Length_Error => null;  -- Expected exception raised.
         when others          =>
           Report.Failed
            ("Incorrect exception raised by To_Bounded_Wide_String");
      end;

      -- Drop = Left 

      Test_String := 
        B10.To_Bounded_Wide_String(Source => Equiv("abcdefghijklmn"),
                                   Drop   => Ada.Strings.Left);

      if Test_String /= B10.To_Bounded_Wide_String(Equiv("efghijklmn")) then
         Report.Failed
           ("Incorrect result from To_Bounded_Wide_String, Drop = Left");
      end if;

      -- Drop = Right 

      Test_String := 
        B10.To_Bounded_Wide_String(Source => Equiv("abcdefghijklmn"),
                                   Drop   => Ada.Strings.Right);

      if not(Test_String = AtoJ_Bnd_Str) then
         Report.Failed
           ("Incorrect result from To_Bounded_Wide_String, Drop = Right");
      end if;




      -- Function Append with Truncation 
      -- Evaluate the function Append with parameters that will 
      -- cause the truncation of the result.

      -- Drop = Error (default case, Length_Error will be raised)

      begin
         -- Append (Bnd Str, Bnd Str);
         Result_String := 
           B10.Append(B10.To_Bounded_Wide_String(Equiv("abcde")),
                      B10.To_Bounded_Wide_String(Equiv("fghijk"))); -- 11 char
         Report.Failed("Length_Error not raised by Append - 1");
      exception
         when AS.Length_Error => null;   -- OK, correct exception raised.
         when others          =>
            Report.Failed("Incorrect exception raised by Append - 1");
      end;

      begin
         -- Append (Str, Bnd Str);
         Result_String := 
           B10.Append(B10.To_Wide_String(AtoE_Bnd_Str),
                      B10.To_Bounded_Wide_String(Equiv("fghijk")), 
                      AS.Error); 
         Report.Failed("Length_Error not raised by Append - 2");
      exception
         when AS.Length_Error => null;   -- OK, correct exception raised.
         when others          =>
            Report.Failed("Incorrect exception raised by Append - 2");
      end;

      begin
         -- Append (Bnd Str, Char);
         Result_String := 
           B10.Append(B10.To_Bounded_Wide_String("abcdefghij"), 'k');
         Report.Failed("Length_Error not raised by Append - 3");
      exception
         when AS.Length_Error => null;   -- OK, correct exception raised.
         when others          =>
            Report.Failed("Incorrect exception raised by Append - 3");
      end;

      -- Drop = Left 

      -- Append (Bnd Str, Bnd Str)
      Result_String := 
        B10.Append(B10.To_Bounded_Wide_String(Equiv("abcdefgh")), -- 8 chs
                   B10.To_Bounded_Wide_String(Equiv("ijklmn")),   -- 6 chs
                   Ada.Strings.Left);

      if Result_String /= 
         B10.To_Bounded_Wide_String(Equiv("efghijklmn"))  -- 10 chars
      then
         Report.Failed("Incorrect truncation performed by Append - 4");
      end if;

      -- Append (Bnd Str, Str)
      Result_String := 
        B10.Append(B10.To_Bounded_Wide_String("abcdefghij"), 
                   "xyz",
                   Ada.Strings.Left);

      if Result_String /= B10.To_Bounded_Wide_String("defghijxyz") then
         Report.Failed("Incorrect truncation performed by Append - 5");
      end if;

      -- Append (Char, Bnd Str)

      Result_String := 
        B10.Append(Equiv('A'), 
                   B10.To_Bounded_Wide_String(Equiv("abcdefghij")),
                   Ada.Strings.Left);

      if Result_String /= B10.To_Bounded_Wide_String(Equiv("abcdefghij")) 
      then
         Report.Failed("Incorrect truncation performed by Append - 6");
      end if;

      -- Drop = Right 

      -- Append (Bnd Str, Bnd Str)
      Result_String := B10.Append(FtoJ_Bnd_Str, 
                                  AtoJ_Bnd_Str,
                                  Ada.Strings.Right);

      if Result_String /= 
         B10.To_Bounded_Wide_String(Equiv("fghijabcde")) 
      then
         Report.Failed("Incorrect truncation performed by Append - 7");
      end if;

      -- Append (Str, Bnd Str)
      Result_String := B10.Append(B10.To_Wide_String(AtoE_Bnd_Str), 
                                  AtoJ_Bnd_Str,
                                  Ada.Strings.Right);

      if Result_String /= 
         B10.To_Bounded_Wide_String(Equiv("abcdeabcde")) 
      then
         Report.Failed("Incorrect truncation performed by Append - 8");
      end if;

      -- Append (Char, Bnd Str)
      Result_String := B10.Append(Equiv('A'), AtoJ_Bnd_Str, Ada.Strings.Right);

      if Result_String /= B10.To_Bounded_Wide_String(Equiv("Aabcdefghi")) then
         Report.Failed("Incorrect truncation performed by Append - 9");
      end if;



      -- Function Index with non-Identity map. 
      -- Evaluate the function Index with a non-identity map 
      -- parameter which will cause mapping of the source parameter 
      -- prior to the evaluation of the index position search.

      Location :=