OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [ada/] [g-spchge.adb] - Blame information for rev 384

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT RUN-TIME COMPONENTS                         --
4
--                                                                          --
5
--          G N A T . S P E L L I N G _ C H E C K E R _ G E N E R I C       --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--                     Copyright (C) 1998-2008, AdaCore                     --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
20
-- Boston, MA 02110-1301, USA.                                              --
21
--                                                                          --
22
-- As a special exception,  if other files  instantiate  generics from this --
23
-- unit, or you link  this unit with other files  to produce an executable, --
24
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
25
-- covered  by the  GNU  General  Public  License.  This exception does not --
26
-- however invalidate  any other reasons why  the executable file  might be --
27
-- covered by the  GNU Public License.                                      --
28
--                                                                          --
29
-- GNAT was originally developed  by the GNAT team at  New York University. --
30
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
31
--                                                                          --
32
------------------------------------------------------------------------------
33
 
34
pragma Compiler_Unit;
35
 
36
package body GNAT.Spelling_Checker_Generic is
37
 
38
   ------------------------
39
   -- Is_Bad_Spelling_Of --
40
   ------------------------
41
 
42
   function Is_Bad_Spelling_Of
43
     (Found  : String_Type;
44
      Expect : String_Type) return Boolean
45
   is
46
      FN : constant Natural := Found'Length;
47
      FF : constant Natural := Found'First;
48
      FL : constant Natural := Found'Last;
49
 
50
      EN : constant Natural := Expect'Length;
51
      EF : constant Natural := Expect'First;
52
      EL : constant Natural := Expect'Last;
53
 
54
      Letter_o : constant Char_Type := Char_Type'Val (Character'Pos ('o'));
55
      Digit_0  : constant Char_Type := Char_Type'Val (Character'Pos ('0'));
56
      Digit_9  : constant Char_Type := Char_Type'Val (Character'Pos ('9'));
57
 
58
   begin
59
      --  If both strings null, then we consider this a match, but if one
60
      --  is null and the other is not, then we definitely do not match
61
 
62
      if FN = 0 then
63
         return (EN = 0);
64
 
65
      elsif EN = 0 then
66
         return False;
67
 
68
         --  If first character does not match, then we consider that this is
69
         --  definitely not a misspelling. An exception is when we expect a
70
         --  letter O and found a zero.
71
 
72
      elsif Found (FF) /= Expect (EF)
73
        and then (Found (FF) /= Digit_0 or else Expect (EF) /= Letter_o)
74
      then
75
         return False;
76
 
77
      --  Not a bad spelling if both strings are 1-2 characters long
78
 
79
      elsif FN < 3 and then EN < 3 then
80
         return False;
81
 
82
      --  Lengths match. Execute loop to check for a single error, single
83
      --  transposition or exact match (we only fall through this loop if
84
      --  one of these three conditions is found).
85
 
86
      elsif FN = EN then
87
         for J in 1 .. FN - 2 loop
88
            if Expect (EF + J) /= Found (FF + J) then
89
 
90
               --  If both mismatched characters are digits, then we do
91
               --  not consider it a misspelling (e.g. B345 is not a
92
               --  misspelling of B346, it is something quite different)
93
 
94
               if Expect (EF + J) in Digit_0 .. Digit_9
95
                 and then Found (FF + J) in Digit_0 .. Digit_9
96
               then
97
                  return False;
98
 
99
               elsif Expect (EF + J + 1) = Found (FF + J + 1)
100
                 and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
101
               then
102
                  return True;
103
 
104
               elsif Expect (EF + J) = Found (FF + J + 1)
105
                 and then Expect (EF + J + 1) = Found (FF + J)
106
                 and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
107
               then
108
                  return True;
109
 
110
               else
111
                  return False;
112
               end if;
113
            end if;
114
         end loop;
115
 
116
         --  At last character. Test digit case as above, otherwise we
117
         --  have a match since at most this last character fails to match.
118
 
119
         if Expect (EL) in Digit_0 .. Digit_9
120
           and then Found (FL) in Digit_0 .. Digit_9
121
           and then Expect (EL) /= Found (FL)
122
         then
123
            return False;
124
         else
125
            return True;
126
         end if;
127
 
128
      --  Length is 1 too short. Execute loop to check for single deletion
129
 
130
      elsif FN = EN - 1 then
131
         for J in 1 .. FN - 1 loop
132
            if Found (FF + J) /= Expect (EF + J) then
133
               return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
134
            end if;
135
         end loop;
136
 
137
         --  If we fall through then the last character was missing, which
138
         --  we consider to be a match (e.g. found xyz, expected xyza).
139
 
140
         return True;
141
 
142
      --  Length is 1 too long. Execute loop to check for single insertion
143
 
144
      elsif FN = EN + 1 then
145
         for J in 1 .. EN - 1 loop
146
            if Found (FF + J) /= Expect (EF + J) then
147
               return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
148
            end if;
149
         end loop;
150
 
151
         --  If we fall through then the last character was an additional
152
         --  character, which is a match (e.g. found xyza, expected xyz).
153
 
154
         return True;
155
 
156
      --  Length is completely wrong
157
 
158
      else
159
         return False;
160
      end if;
161
   end Is_Bad_Spelling_Of;
162
 
163
end GNAT.Spelling_Checker_Generic;

powered by: WebSVN 2.1.0

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