gcc/ada/g-speche.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                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 1998-2005 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 package body GNAT.Spelling_Checker is
  35
  36    ------------------------
  37    -- Is_Bad_Spelling_Of --
  38    ------------------------
  39
  40    function Is_Bad_Spelling_Of
  41      (Found  : String;
  42       Expect : String)
  43       return   Boolean
  44    is
  45       FN : constant Natural := Found'Length;
  46       FF : constant Natural := Found'First;
  47       FL : constant Natural := Found'Last;
  48
  49       EN : constant Natural := Expect'Length;
  50       EF : constant Natural := Expect'First;
  51       EL : constant Natural := Expect'Last;
  52
  53    begin
  54       --  If both strings null, then we consider this a match, but if one
  55       --  is null and the other is not, then we definitely do not match
  56
  57       if FN = 0 then
  58          return (EN = 0);
  59
  60       elsif EN = 0 then
  61          return False;
  62
  63       --  If first character does not match, then definitely not misspelling
  64
  65       elsif Found (FF) /= Expect (EF) then
  66          return False;
  67
  68       --  Not a bad spelling if both strings are 1-2 characters long
  69
  70       elsif FN < 3 and then EN < 3 then
  71          return False;
  72
  73       --  Lengths match. Execute loop to check for a single error, single
  74       --  transposition or exact match (we only fall through this loop if
  75       --  one of these three conditions is found).
  76
  77       elsif FN = EN then
  78          for J in 1 .. FN - 2 loop
  79             if Expect (EF + J) /= Found (FF + J) then
  80
  81                --  If both mismatched characters are digits, then we do
  82                --  not consider it a misspelling (e.g. B345 is not a
  83                --  misspelling of B346, it is something quite different)
  84
  85                if Expect (EF + J) in '0' .. '9'
  86                  and then Found (FF + J) in '0' .. '9'
  87                then
  88                   return False;
  89
  90                elsif Expect (EF + J + 1) = Found (FF + J + 1)
  91                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
  92                then
  93                   return True;
  94
  95                elsif Expect (EF + J) = Found (FF + J + 1)
  96                  and then Expect (EF + J + 1) = Found (FF + J)
  97                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
  98                then
  99                   return True;
 100
 101                else
 102                   return False;
 103                end if;
 104             end if;
 105          end loop;
 106
 107          --  At last character. Test digit case as above, otherwise we
 108          --  have a match since at most this last character fails to match.
 109
 110          if Expect (EL) in '0' .. '9'
 111            and then Found (FL) in '0' .. '9'
 112            and then Expect (EL) /= Found (FL)
 113          then
 114             return False;
 115          else
 116             return True;
 117          end if;
 118
 119       --  Length is 1 too short. Execute loop to check for single deletion
 120
 121       elsif FN = EN - 1 then
 122          for J in 1 .. FN - 1 loop
 123             if Found (FF + J) /= Expect (EF + J) then
 124                return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
 125             end if;
 126          end loop;
 127
 128          --  If we fall through then the last character was missing, which
 129          --  we consider to be a match (e.g. found xyz, expected xyza).
 130
 131          return True;
 132
 133       --  Length is 1 too long. Execute loop to check for single insertion
 134
 135       elsif FN = EN + 1 then
 136          for J in 1 .. EN - 1 loop
 137             if Found (FF + J) /= Expect (EF + J) then
 138                return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
 139             end if;
 140          end loop;
 141
 142          --  If we fall through then the last character was an additional
 143          --  character, which is a match (e.g. found xyza, expected xyz).
 144
 145          return True;
 146
 147       --  Length is completely wrong
 148
 149       else
 150          return False;
 151       end if;
 152
 153    end Is_Bad_Spelling_Of;
 154
 155 end GNAT.Spelling_Checker;