gcc/ada/libgnat/g-spchge.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 _ G E N E R I C       --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 1998-2023, 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 3,  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.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 package body GNAT.Spelling_Checker_Generic is
  33
  34    ------------------------
  35    -- Is_Bad_Spelling_Of --
  36    ------------------------
  37
  38    function Is_Bad_Spelling_Of
  39      (Found  : String_Type;
  40       Expect : String_Type) return Boolean
  41    is
  42       FN : constant Natural := Found'Length;
  43       FF : constant Natural := Found'First;
  44       FL : constant Natural := Found'Last;
  45
  46       EN : constant Natural := Expect'Length;
  47       EF : constant Natural := Expect'First;
  48       EL : constant Natural := Expect'Last;
  49
  50       Letter_o : constant Char_Type := Char_Type'Val (Character'Pos ('o'));
  51       Digit_0  : constant Char_Type := Char_Type'Val (Character'Pos ('0'));
  52       Digit_9  : constant Char_Type := Char_Type'Val (Character'Pos ('9'));
  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 we consider that this is
  65          --  definitely not a misspelling. An exception is when we expect a
  66          --  letter O and found a zero.
  67
  68       elsif Found (FF) /= Expect (EF)
  69         and then (Found (FF) /= Digit_0 or else Expect (EF) /= Letter_o)
  70       then
  71          return False;
  72
  73       --  Not a bad spelling if both strings are 1-2 characters long
  74
  75       elsif FN < 3 and then EN < 3 then
  76          return False;
  77
  78       --  Lengths match. Execute loop to check for a single error, single
  79       --  transposition or exact match (we only fall through this loop if
  80       --  one of these three conditions is found).
  81
  82       elsif FN = EN then
  83          for J in 1 .. FN - 2 loop
  84             if Expect (EF + J) /= Found (FF + J) then
  85
  86                --  If both mismatched characters are digits, then we do
  87                --  not consider it a misspelling (e.g. B345 is not a
  88                --  misspelling of B346, it is something quite different)
  89
  90                if Expect (EF + J) in Digit_0 .. Digit_9
  91                  and then Found (FF + J) in Digit_0 .. Digit_9
  92                then
  93                   return False;
  94
  95                elsif Expect (EF + J + 1) = Found (FF + J + 1)
  96                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
  97                then
  98                   return True;
  99
 100                elsif Expect (EF + J) = Found (FF + J + 1)
 101                  and then Expect (EF + J + 1) = Found (FF + J)
 102                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
 103                then
 104                   return True;
 105
 106                else
 107                   return False;
 108                end if;
 109             end if;
 110          end loop;
 111
 112          --  At last character. Test digit case as above, otherwise we
 113          --  have a match since at most this last character fails to match.
 114
 115          if Expect (EL) in Digit_0 .. Digit_9
 116            and then Found (FL) in Digit_0 .. Digit_9
 117            and then Expect (EL) /= Found (FL)
 118          then
 119             return False;
 120          else
 121             return True;
 122          end if;
 123
 124       --  Length is 1 too short. Execute loop to check for single deletion
 125
 126       elsif FN = EN - 1 then
 127          for J in 1 .. FN - 1 loop
 128             if Found (FF + J) /= Expect (EF + J) then
 129                return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
 130             end if;
 131          end loop;
 132
 133          --  If we fall through then the last character was missing, which
 134          --  we consider to be a match (e.g. found xyz, expected xyza).
 135
 136          return True;
 137
 138       --  Length is 1 too long. Execute loop to check for single insertion
 139
 140       elsif FN = EN + 1 then
 141          for J in 1 .. EN - 1 loop
 142             if Found (FF + J) /= Expect (EF + J) then
 143                return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
 144             end if;
 145          end loop;
 146
 147          --  If we fall through then the last character was an additional
 148          --  character, which is a match (e.g. found xyza, expected xyz).
 149
 150          return True;
 151
 152       --  Length is completely wrong
 153
 154       else
 155          return False;
 156       end if;
 157    end Is_Bad_Spelling_Of;
 158
 159 end GNAT.Spelling_Checker_Generic;