gcc/ada/g-speche.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUNTIME 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 --                            $Revision: 1.3 $
  10 --                                                                          --
  11 --           Copyright (C) 1998-2001 Ada Core Technologies, Inc.            --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- As a special exception,  if other files  instantiate  generics from this --
  25 -- unit, or you link  this unit with other files  to produce an executable, --
  26 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27 -- covered  by the  GNU  General  Public  License.  This exception does not --
  28 -- however invalidate  any other reasons why  the executable file  might be --
  29 -- covered by the  GNU Public License.                                      --
  30 --                                                                          --
  31 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
  32 --                                                                          --
  33 ------------------------------------------------------------------------------
  34
  35 package body GNAT.Spelling_Checker is
  36
  37    ------------------------
  38    -- Is_Bad_Spelling_Of --
  39    ------------------------
  40
  41    function Is_Bad_Spelling_Of
  42      (Found  : String;
  43       Expect : String)
  44       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    begin
  55       --  If both strings null, then we consider this a match, but if one
  56       --  is null and the other is not, then we definitely do not match
  57
  58       if FN = 0 then
  59          return (EN = 0);
  60
  61       elsif EN = 0 then
  62          return False;
  63
  64       --  If first character does not match, then definitely not misspelling
  65
  66       elsif Found (FF) /= Expect (EF) then
  67          return False;
  68
  69       --  Not a bad spelling if both strings are 1-2 characters long
  70
  71       elsif FN < 3 and then EN < 3 then
  72          return False;
  73
  74       --  Lengths match. Execute loop to check for a single error, single
  75       --  transposition or exact match (we only fall through this loop if
  76       --  one of these three conditions is found).
  77
  78       elsif FN = EN then
  79          for J in 1 .. FN - 2 loop
  80             if Expect (EF + J) /= Found (FF + J) then
  81
  82                --  If both mismatched characters are digits, then we do
  83                --  not consider it a misspelling (e.g. B345 is not a
  84                --  misspelling of B346, it is something quite different)
  85
  86                if Expect (EF + J) in '0' .. '9'
  87                  and then Found (FF + J) in '0' .. '9'
  88                then
  89                   return False;
  90
  91                elsif Expect (EF + J + 1) = Found (FF + J + 1)
  92                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
  93                then
  94                   return True;
  95
  96                elsif Expect (EF + J) = Found (FF + J + 1)
  97                  and then Expect (EF + J + 1) = Found (FF + J)
  98                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
  99                then
 100                   return True;
 101
 102                else
 103                   return False;
 104                end if;
 105             end if;
 106          end loop;
 107
 108          --  At last character. Test digit case as above, otherwise we
 109          --  have a match since at most this last character fails to match.
 110
 111          if Expect (EL) in '0' .. '9'
 112            and then Found (FL) in '0' .. '9'
 113            and then Expect (EL) /= Found (FL)
 114          then
 115             return False;
 116          else
 117             return True;
 118          end if;
 119
 120       --  Length is 1 too short. Execute loop to check for single deletion
 121
 122       elsif FN = EN - 1 then
 123          for J in 1 .. FN - 1 loop
 124             if Found (FF + J) /= Expect (EF + J) then
 125                return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
 126             end if;
 127          end loop;
 128
 129          --  If we fall through then the last character was missing, which
 130          --  we consider to be a match (e.g. found xyz, expected xyza).
 131
 132          return True;
 133
 134       --  Length is 1 too long. Execute loop to check for single insertion
 135
 136       elsif FN = EN + 1 then
 137          for J in 1 .. FN - 1 loop
 138             if Found (FF + J) /= Expect (EF + J) then
 139                return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
 140             end if;
 141          end loop;
 142
 143          --  If we fall through then the last character was an additional
 144          --  character, which is a match (e.g. found xyza, expected xyz).
 145
 146          return True;
 147
 148       --  Length is completely wrong
 149
 150       else
 151          return False;
 152       end if;
 153
 154    end Is_Bad_Spelling_Of;
 155
 156 end GNAT.Spelling_Checker;