view gcc/testsuite/ada/acats/tests/cxa/cxa4013.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line source

-- CXA4013.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_Fixed
--      are available, and that they produce correct results.  Specifically,
--      check the subprograms Index, "*" (Wide_String constructor function),
--      Count, Trim, and Replace_Slice.
--
-- TEST DESCRIPTION:
--      This test demonstrates how certain Wide_Fixed string functions
--      are used to eliminate specific substrings from portions of text.  
--      A procedure is defined that will take as parameters a source 
--      Wide_String along with a substring that is to be completely removed
--      from the source string.  The source Wide_String is parsed using the
--      Index function, and any substring slices are replaced in the source
--      Wide_String by a series of X's (based on the length of the substring.)  
--      Three lines of text are provided to this procedure, and the resulting
--      substitutions are compared with expected results to validate the 
--      string processing.
--      A global accumulator is updated with the number of occurrences of the
--      substring in the source string.  
--
--       
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

with Ada.Strings;
with Ada.Strings.Wide_Fixed;
with Ada.Strings.Wide_Maps;
with Report;

procedure CXA4013 is

begin

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

   Test_Block:
   declare

      TC_Total        : Natural  := 0;
      Number_Of_Lines : constant := 3;
      WC              : Wide_Character := 
                          Wide_Character'Val(Character'Pos('X')            + 
                                             Character'Pos(Character'Last) + 
                                             1 );

      subtype WS is Wide_String (1..25);

      type Restricted_Words_Array_Type is 
        array (1..10) of Wide_String (1..10);

      Restricted_Words : Restricted_Words_Array_Type := 
                           ("   platoon", " marines  ", "  Marines ",
                            "north     ", "south     ", "      east", 
                            "  beach   ", "   airport", "airfield  ", 
                            "     road ");

      type Page_Of_Text_Type is array (1..Number_Of_Lines) of WS;

      Text_Page : Page_Of_Text_Type := ("The platoon of Marines   ",
                                        "moved south on the south ",
                                        "road to the airfield.    ");

      TC_Revised_Line_1 : constant Wide_String := "The XXXXXXX of XXXXXXX   ";
      TC_Revised_Line_2 : constant Wide_String := "moved XXXXX on the XXXXX ";
      TC_Revised_Line_3 : constant Wide_String := "XXXX to the XXXXXXXX.    ";


      function Equivalent (Left : WS;  Right : Wide_String) 
        return Boolean is
      begin
         for i in WS'range loop
            if Left(i) /= Right(i) then
               if Left(i) /= WC   or  Right(i) /= 'X' then
                  return False;
               end if;
            end if;
         end loop;
         return True;
      end Equivalent;

      ---

      procedure Censor (Source_String  : in out Wide_String;
                        Pattern_String : in     Wide_String) is
                        
         use Ada.Strings.Wide_Fixed; -- allows infix notation of "*" below.

         -- Create a replacement string that is the same length as the
         -- pattern string being removed.  Use the infix notation of the 
         -- wide string constructor function.

         Replacement : constant Wide_String :=                       
                         Pattern_String'Length * WC;                 -- "*"

         Going     : Ada.Strings.Direction := Ada.Strings.Forward;   
         Start_Pos,
         Index     : Natural := Source_String'First;

      begin  -- Censor

         -- Accumulate count of total replacement operations.

         TC_Total := TC_Total +                                     
                      Ada.Strings.Wide_Fixed.Count                  -- Count
                        (Source  => Source_String,
                         Pattern => Pattern_String,
                         Mapping => Ada.Strings.Wide_Maps.Identity);
         loop

            Index := Ada.Strings.Wide_Fixed.Index                   -- Index
                       (Source_String(Start_Pos..Source_String'Last),
                        Pattern_String, 
                        Going, 
                        Ada.Strings.Wide_Maps.Identity);

            exit when Index = 0;   -- No matches, exit loop.

            -- if a match was found, modify the substring.
            Ada.Strings.Wide_Fixed.Replace_Slice              -- Replace_Slice
                                     (Source_String,
                                      Index,
                                      Index + Pattern_String'Length - 1,
                                      Replacement);
            Start_Pos := Index + Pattern_String'Length;

         end loop;

      end Censor;


   begin

      -- Invoke Censor subprogram to cleanse text.
      -- Loop through each line of text, and check for the presence of each
      -- restricted word.
      -- Use the Trim function to eliminate leading or trailing blanks from
      -- the restricted word parameters.

      for Line in 1..Number_Of_Lines loop
         for Word in Restricted_Words'Range loop
             Censor (Text_Page(Line),                                 -- Trim
                     Ada.Strings.Wide_Fixed.Trim(Restricted_Words(Word),
                                                 Ada.Strings.Both));
         end loop;
      end loop;


      -- Validate results.

      if TC_Total /= 6 then
         Report.Failed ("Incorrect number of substitutions performed");
      end if;

      if not Equivalent (Text_Page(1), TC_Revised_Line_1) then
         Report.Failed ("Incorrect substitutions on Line 1");
      end if;

      if not Equivalent (Text_Page(2), TC_Revised_Line_2) then
         Report.Failed ("Incorrect substitutions on Line 2");
      end if;

      if not Equivalent (Text_Page(3), TC_Revised_Line_3) then
         Report.Failed ("Incorrect substitutions on Line 3");
      end if;


   exception
      when others => Report.Failed ("Exception raised in Test_Block");
   end Test_Block;


   Report.Result;

end CXA4013;