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