111
|
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 -- --
|
131
|
9 -- Copyright (C) 1998-2018, AdaCore --
|
111
|
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 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
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;
|