OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxa4013.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CXA4013.A
2
--
3
--                             Grant of Unlimited Rights
4
--
5
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7
--     unlimited rights in the software and documentation contained herein.
8
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9
--     this public release, the Government intends to confer upon all
10
--     recipients unlimited rights  equal to those held by the Government.
11
--     These rights include rights to use, duplicate, release or disclose the
12
--     released technical data and computer software in whole or in part, in
13
--     any manner and for any purpose whatsoever, and to have or permit others
14
--     to do so.
15
--
16
--                                    DISCLAIMER
17
--
18
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23
--     PARTICULAR PURPOSE OF SAID MATERIAL.
24
--*
25
--
26
-- OBJECTIVE:
27
--      Check that the subprograms defined in package Ada.Strings.Wide_Fixed
28
--      are available, and that they produce correct results.  Specifically,
29
--      check the subprograms Index, "*" (Wide_String constructor function),
30
--      Count, Trim, and Replace_Slice.
31
--
32
-- TEST DESCRIPTION:
33
--      This test demonstrates how certain Wide_Fixed string functions
34
--      are used to eliminate specific substrings from portions of text.
35
--      A procedure is defined that will take as parameters a source
36
--      Wide_String along with a substring that is to be completely removed
37
--      from the source string.  The source Wide_String is parsed using the
38
--      Index function, and any substring slices are replaced in the source
39
--      Wide_String by a series of X's (based on the length of the substring.)
40
--      Three lines of text are provided to this procedure, and the resulting
41
--      substitutions are compared with expected results to validate the
42
--      string processing.
43
--      A global accumulator is updated with the number of occurrences of the
44
--      substring in the source string.
45
--
46
--
47
-- CHANGE HISTORY:
48
--      06 Dec 94   SAIC    ACVC 2.0
49
--
50
--!
51
 
52
with Ada.Strings;
53
with Ada.Strings.Wide_Fixed;
54
with Ada.Strings.Wide_Maps;
55
with Report;
56
 
57
procedure CXA4013 is
58
 
59
begin
60
 
61
   Report.Test ("CXA4013", "Check that the subprograms defined in package "  &
62
                           "Ada.Strings.Wide_Fixed are available, and that " &
63
                           "they produce correct results");
64
 
65
   Test_Block:
66
   declare
67
 
68
      TC_Total        : Natural  := 0;
69
      Number_Of_Lines : constant := 3;
70
      WC              : Wide_Character :=
71
                          Wide_Character'Val(Character'Pos('X')            +
72
                                             Character'Pos(Character'Last) +
73
                                             1 );
74
 
75
      subtype WS is Wide_String (1..25);
76
 
77
      type Restricted_Words_Array_Type is
78
        array (1..10) of Wide_String (1..10);
79
 
80
      Restricted_Words : Restricted_Words_Array_Type :=
81
                           ("   platoon", " marines  ", "  Marines ",
82
                            "north     ", "south     ", "      east",
83
                            "  beach   ", "   airport", "airfield  ",
84
                            "     road ");
85
 
86
      type Page_Of_Text_Type is array (1..Number_Of_Lines) of WS;
87
 
88
      Text_Page : Page_Of_Text_Type := ("The platoon of Marines   ",
89
                                        "moved south on the south ",
90
                                        "road to the airfield.    ");
91
 
92
      TC_Revised_Line_1 : constant Wide_String := "The XXXXXXX of XXXXXXX   ";
93
      TC_Revised_Line_2 : constant Wide_String := "moved XXXXX on the XXXXX ";
94
      TC_Revised_Line_3 : constant Wide_String := "XXXX to the XXXXXXXX.    ";
95
 
96
 
97
      function Equivalent (Left : WS;  Right : Wide_String)
98
        return Boolean is
99
      begin
100
         for i in WS'range loop
101
            if Left(i) /= Right(i) then
102
               if Left(i) /= WC   or  Right(i) /= 'X' then
103
                  return False;
104
               end if;
105
            end if;
106
         end loop;
107
         return True;
108
      end Equivalent;
109
 
110
      ---
111
 
112
      procedure Censor (Source_String  : in out Wide_String;
113
                        Pattern_String : in     Wide_String) is
114
 
115
         use Ada.Strings.Wide_Fixed; -- allows infix notation of "*" below.
116
 
117
         -- Create a replacement string that is the same length as the
118
         -- pattern string being removed.  Use the infix notation of the
119
         -- wide string constructor function.
120
 
121
         Replacement : constant Wide_String :=
122
                         Pattern_String'Length * WC;                 -- "*"
123
 
124
         Going     : Ada.Strings.Direction := Ada.Strings.Forward;
125
         Start_Pos,
126
         Index     : Natural := Source_String'First;
127
 
128
      begin  -- Censor
129
 
130
         -- Accumulate count of total replacement operations.
131
 
132
         TC_Total := TC_Total +
133
                      Ada.Strings.Wide_Fixed.Count                  -- Count
134
                        (Source  => Source_String,
135
                         Pattern => Pattern_String,
136
                         Mapping => Ada.Strings.Wide_Maps.Identity);
137
         loop
138
 
139
            Index := Ada.Strings.Wide_Fixed.Index                   -- Index
140
                       (Source_String(Start_Pos..Source_String'Last),
141
                        Pattern_String,
142
                        Going,
143
                        Ada.Strings.Wide_Maps.Identity);
144
 
145
            exit when Index = 0;   -- No matches, exit loop.
146
 
147
            -- if a match was found, modify the substring.
148
            Ada.Strings.Wide_Fixed.Replace_Slice              -- Replace_Slice
149
                                     (Source_String,
150
                                      Index,
151
                                      Index + Pattern_String'Length - 1,
152
                                      Replacement);
153
            Start_Pos := Index + Pattern_String'Length;
154
 
155
         end loop;
156
 
157
      end Censor;
158
 
159
 
160
   begin
161
 
162
      -- Invoke Censor subprogram to cleanse text.
163
      -- Loop through each line of text, and check for the presence of each
164
      -- restricted word.
165
      -- Use the Trim function to eliminate leading or trailing blanks from
166
      -- the restricted word parameters.
167
 
168
      for Line in 1..Number_Of_Lines loop
169
         for Word in Restricted_Words'Range loop
170
             Censor (Text_Page(Line),                                 -- Trim
171
                     Ada.Strings.Wide_Fixed.Trim(Restricted_Words(Word),
172
                                                 Ada.Strings.Both));
173
         end loop;
174
      end loop;
175
 
176
 
177
      -- Validate results.
178
 
179
      if TC_Total /= 6 then
180
         Report.Failed ("Incorrect number of substitutions performed");
181
      end if;
182
 
183
      if not Equivalent (Text_Page(1), TC_Revised_Line_1) then
184
         Report.Failed ("Incorrect substitutions on Line 1");
185
      end if;
186
 
187
      if not Equivalent (Text_Page(2), TC_Revised_Line_2) then
188
         Report.Failed ("Incorrect substitutions on Line 2");
189
      end if;
190
 
191
      if not Equivalent (Text_Page(3), TC_Revised_Line_3) then
192
         Report.Failed ("Incorrect substitutions on Line 3");
193
      end if;
194
 
195
 
196
   exception
197
      when others => Report.Failed ("Exception raised in Test_Block");
198
   end Test_Block;
199
 
200
 
201
   Report.Result;
202
 
203
end CXA4013;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.