cxa4004.a

来自「用于进行gcc测试」· A 代码 · 共 432 行 · 第 1/2 页

-- CXA4004.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.Fixed are
--      available, and that they produce correct results. Specifically, check 
--      the subprograms Count, Find_Token, Index, Index_Non_Blank, and Move.
--      
-- TEST DESCRIPTION:
--      This test, when combined with tests CXA4002,3, and 5 will provide 
--      thorough coverage of the functionality found in Ada.Strings.Fixed.  
--      This test contains many small, specific test cases, situations that 
--      although common in user environments, are often difficult to generate 
--      in large numbers in a application-based test.
--
--       
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      10 Apr 95   SAIC    Corrected subtest for Move, Drop=Right.
--
--!

with Report;
with Ada.Strings;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;

procedure CXA4004 is
begin

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

   Test_Block:
   declare

      package ASF  renames Ada.Strings.Fixed;
      package Maps renames Ada.Strings.Maps;

      Result_String  : String(1..10) := (others => Ada.Strings.Space);

      Source_String1 : String(1..5)  := "abcde";        -- odd length string
      Source_String2 : String(1..6)  := "abcdef";       -- even length string
      Source_String3 : String(1..12) := "abcdefghijkl";   
      Source_String4 : String(1..12) := "abcdefghij  "; -- last two ch pad
      Source_String5 : String(1..12) := "  cdefghijkl"; -- first two ch pad
      Source_String6 : String(1..12) := "abcdefabcdef";   
                                                                              
      Location       : Natural := 0;
      Slice_Start    : Positive;
      Slice_End,
      Slice_Count    : Natural := 0;

      CD_Set         : Maps.Character_Set := Maps.To_Set("cd");  
      ABCD_Set       : Maps.Character_Set := Maps.To_Set("abcd");
      A_to_F_Set     : Maps.Character_Set := Maps.To_Set("abcdef");
                  
      CD_to_XY_Map   : Maps.Character_Mapping :=
                         Maps.To_Mapping(From => "cd",  To => "xy");

   begin

      -- Procedure Move

      -- Evaluate the Procedure Move with various combinations of
      -- parameters.

      -- Justify = Left (default case)
     
      ASF.Move(Source => Source_String1,       -- "abcde"
               Target => Result_String);
      
      if Result_String /= "abcde     " then
         Report.Failed("Incorrect result from Move with Justify = Left");
      end if;
 
      -- Justify = Right
 
      ASF.Move(Source  => Source_String2,      -- "abcdef"
               Target  => Result_String,
               Drop    => Ada.Strings.Error,
               Justify => Ada.Strings.Right);

      if Result_String /= "    abcdef" then
         Report.Failed("Incorrect result from Move with Justify = Right");
      end if;

      -- Justify = Center (two cases, odd and even pad lengths)
 
      ASF.Move(Source_String1,                 -- "abcde"
               Result_String,
               Ada.Strings.Error,
               Ada.Strings.Center,
               'x');                           -- non-default padding.

      if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
         Report.Failed("Incorrect result from Move with Justify = Center-1");
      end if;

      ASF.Move(Source_String2,                 -- "abcdef"
               Result_String,
               Ada.Strings.Error,
               Ada.Strings.Center);

      if Result_String /= "  abcdef  " then  -- Equal padding added on L/R.
         Report.Failed("Incorrect result from Move with Justify = Center-2");
      end if;

      -- When the source string is longer than the target string, several
      -- cases can be examined, with the results depending on the value of
      -- the Drop parameter.

      -- Drop = Left

      ASF.Move(Source => Source_String3,       -- "abcdefghijkl"
               Target => Result_String,
               Drop   => Ada.Strings.Left);

      if Result_String /= "cdefghijkl" then
         Report.Failed("Incorrect result from Move with Drop = Left");
      end if;

      -- Drop = Right
     
      ASF.Move(Source_String3, Result_String, Ada.Strings.Right);

      if Result_String /= "abcdefghij" then
         Report.Failed("Incorrect result from Move with Drop = Right");
      end if;

      -- Drop = Error
      -- The effect in this case depends on the value of the justify
      -- parameter, and on whether any characters in Source other than 
      -- Pad would fail to be copied.

      -- Drop = Error, Justify = Left, right overflow characters are pad.

      ASF.Move(Source  => Source_String4,      -- "abcdefghij  "
               Target  => Result_String,
               Drop    => Ada.Strings.Error,
               Justify => Ada.Strings.Left);

      if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
          Report.Failed("Incorrect result from Move with Drop = Error - 1");
      end if;

      -- Drop = Error, Justify = Right, left overflow characters are pad.

      ASF.Move(Source_String5,                 -- "  cdefghijkl"
               Result_String, 
               Ada.Strings.Error, 
               Ada.Strings.Right);

      if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
         Report.Failed("Incorrect result from Move with Drop = Error - 2");
      end if;

      -- In other cases of Drop=Error, Length_Error is propagated, such as:

      begin

         ASF.Move(Source_String3,     -- 12 characters, no Pad.
                  Result_String,      -- 10 characters
                  Ada.Strings.Error,  
                  Ada.Strings.Left);  

         Report.Failed("Length_Error not raised by Move - 1");

      exception
         when Ada.Strings.Length_Error => null;   -- OK
         when others => 
            Report.Failed("Incorrect exception raised by Move - 1");
      end;



      -- Function Index
      -- (Other usage examples of this function found in CXA4002-3.)
      -- Check when the pattern is not found in the source.

      if ASF.Index("abcdef", "gh")       /= 0 or
         ASF.Index("abcde",  "abcdef")   /= 0 or  -- pattern > source
         ASF.Index("xyz", 
                   "abcde", 
                   Ada.Strings.Backward) /= 0 or
         ASF.Index("",      "ab")        /= 0 or  -- null source string.
         ASF.Index("abcde", "  ")        /= 0     -- blank pattern.
      then
         Report.Failed("Incorrect result from Index, no pattern match");
      end if;

      -- Check that Pattern_Error is raised when the pattern is the 
      -- null string.