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-2006, 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) 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 we consider that this is
  63          --  definitely not a misspelling. An exception is when we expect a
  64          --  letter O and found a zero.
  65
  66       elsif Found (FF) /= Expect (EF)
  67         and then (Found (FF) /= '0'
  68                     or else (Expect (EF) /= 'o' and then Expect (EF) /= 'O'))
  69       then
  70          return False;
  71
  72       --  Not a bad spelling if both strings are 1-2 characters long
  73
  74       elsif FN < 3 and then EN < 3 then
  75          return False;
  76
  77       --  Lengths match. Execute loop to check for a single error, single
  78       --  transposition or exact match (we only fall through this loop if
  79       --  one of these three conditions is found).
  80
  81       elsif FN = EN then
  82          for J in 1 .. FN - 2 loop
  83             if Expect (EF + J) /= Found (FF + J) then
  84
  85                --  If both mismatched characters are digits, then we do
  86                --  not consider it a misspelling (e.g. B345 is not a
  87                --  misspelling of B346, it is something quite different)
  88
  89                if Expect (EF + J) in '0' .. '9'
  90                  and then Found (FF + J) in '0' .. '9'
  91                then
  92                   return False;
  93
  94                elsif Expect (EF + J + 1) = Found (FF + J + 1)
  95                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
  96                then
  97                   return True;
  98
  99                elsif Expect (EF + J) = Found (FF + J + 1)
 100                  and then Expect (EF + J + 1) = Found (FF + J)
 101                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
 102                then
 103                   return True;
 104
 105                else
 106                   return False;
 107                end if;
 108             end if;
 109          end loop;
 110
 111          --  At last character. Test digit case as above, otherwise we
 112          --  have a match since at most this last character fails to match.
 113
 114          if Expect (EL) in '0' .. '9'
 115            and then Found (FL) in '0' .. '9'
 116            and then Expect (EL) /= Found (FL)
 117          then
 118             return False;
 119          else
 120             return True;
 121          end if;
 122
 123       --  Length is 1 too short. Execute loop to check for single deletion
 124
 125       elsif FN = EN - 1 then
 126          for J in 1 .. FN - 1 loop
 127             if Found (FF + J) /= Expect (EF + J) then
 128                return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
 129             end if;
 130          end loop;
 131
 132          --  If we fall through then the last character was missing, which
 133          --  we consider to be a match (e.g. found xyz, expected xyza).
 134
 135          return True;
 136
 137       --  Length is 1 too long. Execute loop to check for single insertion
 138
 139       elsif FN = EN + 1 then
 140          for J in 1 .. EN - 1 loop
 141             if Found (FF + J) /= Expect (EF + J) then
 142                return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
 143             end if;
 144          end loop;
 145
 146          --  If we fall through then the last character was an additional
 147          --  character, which is a match (e.g. found xyza, expected xyz).
 148
 149          return True;
 150
 151       --  Length is completely wrong
 152
 153       else
 154          return False;
 155       end if;
 156    end Is_Bad_Spelling_Of;
 157
 158 end GNAT.Spelling_Checker;