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