OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-spchge.adb] - Blame information for rev 747

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.