File : g-spchge.adb
1 ------------------------------------------------------------------------------
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-2013, 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 3, 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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 pragma Compiler_Unit_Warning;
33
34 package body GNAT.Spelling_Checker_Generic is
35
36 ------------------------
37 -- Is_Bad_Spelling_Of --
38 ------------------------
39
40 function Is_Bad_Spelling_Of
41 (Found : String_Type;
42 Expect : String_Type) return Boolean
43 is
44 FN : constant Natural := Found'Length;
45 FF : constant Natural := Found'First;
46 FL : constant Natural := Found'Last;
47
48 EN : constant Natural := Expect'Length;
49 EF : constant Natural := Expect'First;
50 EL : constant Natural := Expect'Last;
51
52 Letter_o : constant Char_Type := Char_Type'Val (Character'Pos ('o'));
53 Digit_0 : constant Char_Type := Char_Type'Val (Character'Pos ('0'));
54 Digit_9 : constant Char_Type := Char_Type'Val (Character'Pos ('9'));
55
56 begin
57 -- If both strings null, then we consider this a match, but if one
58 -- is null and the other is not, then we definitely do not match
59
60 if FN = 0 then
61 return (EN = 0);
62
63 elsif EN = 0 then
64 return False;
65
66 -- If first character does not match, then we consider that this is
67 -- definitely not a misspelling. An exception is when we expect a
68 -- letter O and found a zero.
69
70 elsif Found (FF) /= Expect (EF)
71 and then (Found (FF) /= Digit_0 or else Expect (EF) /= Letter_o)
72 then
73 return False;
74
75 -- Not a bad spelling if both strings are 1-2 characters long
76
77 elsif FN < 3 and then EN < 3 then
78 return False;
79
80 -- Lengths match. Execute loop to check for a single error, single
81 -- transposition or exact match (we only fall through this loop if
82 -- one of these three conditions is found).
83
84 elsif FN = EN then
85 for J in 1 .. FN - 2 loop
86 if Expect (EF + J) /= Found (FF + J) then
87
88 -- If both mismatched characters are digits, then we do
89 -- not consider it a misspelling (e.g. B345 is not a
90 -- misspelling of B346, it is something quite different)
91
92 if Expect (EF + J) in Digit_0 .. Digit_9
93 and then Found (FF + J) in Digit_0 .. Digit_9
94 then
95 return False;
96
97 elsif Expect (EF + J + 1) = Found (FF + J + 1)
98 and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
99 then
100 return True;
101
102 elsif Expect (EF + J) = Found (FF + J + 1)
103 and then Expect (EF + J + 1) = Found (FF + J)
104 and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
105 then
106 return True;
107
108 else
109 return False;
110 end if;
111 end if;
112 end loop;
113
114 -- At last character. Test digit case as above, otherwise we
115 -- have a match since at most this last character fails to match.
116
117 if Expect (EL) in Digit_0 .. Digit_9
118 and then Found (FL) in Digit_0 .. Digit_9
119 and then Expect (EL) /= Found (FL)
120 then
121 return False;
122 else
123 return True;
124 end if;
125
126 -- Length is 1 too short. Execute loop to check for single deletion
127
128 elsif FN = EN - 1 then
129 for J in 1 .. FN - 1 loop
130 if Found (FF + J) /= Expect (EF + J) then
131 return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
132 end if;
133 end loop;
134
135 -- If we fall through then the last character was missing, which
136 -- we consider to be a match (e.g. found xyz, expected xyza).
137
138 return True;
139
140 -- Length is 1 too long. Execute loop to check for single insertion
141
142 elsif FN = EN + 1 then
143 for J in 1 .. EN - 1 loop
144 if Found (FF + J) /= Expect (EF + J) then
145 return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
146 end if;
147 end loop;
148
149 -- If we fall through then the last character was an additional
150 -- character, which is a match (e.g. found xyza, expected xyz).
151
152 return True;
153
154 -- Length is completely wrong
155
156 else
157 return False;
158 end if;
159 end Is_Bad_Spelling_Of;
160
161 end GNAT.Spelling_Checker_Generic;