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-2018, 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-- 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
32pragma Compiler_Unit_Warning;
33
34package 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
161end GNAT.Spelling_Checker_Generic;
162