--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- 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 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1998-2007, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+pragma Warnings (Off);
+pragma Compiler_Unit;
+pragma Warnings (On);
+
+package body GNAT.Spelling_Checker_Generic is
+
+ ------------------------
+ -- Is_Bad_Spelling_Of --
+ ------------------------
+
+ function Is_Bad_Spelling_Of
+ (Found : String_Type;
+ Expect : String_Type) return Boolean
+ is
+ FN : constant Natural := Found'Length;
+ FF : constant Natural := Found'First;
+ FL : constant Natural := Found'Last;
+
+ EN : constant Natural := Expect'Length;
+ EF : constant Natural := Expect'First;
+ EL : constant Natural := Expect'Last;
+
+ Letter_o : constant Char_Type := Char_Type'Val (Character'Pos ('o'));
+ Digit_0 : constant Char_Type := Char_Type'Val (Character'Pos ('0'));
+ Digit_9 : constant Char_Type := Char_Type'Val (Character'Pos ('9'));
+
+ begin
+ -- If both strings null, then we consider this a match, but if one
+ -- is null and the other is not, then we definitely do not match
+
+ if FN = 0 then
+ return (EN = 0);
+
+ elsif EN = 0 then
+ return False;
+
+ -- If first character does not match, then we consider that this is
+ -- definitely not a misspelling. An exception is when we expect a
+ -- letter O and found a zero.
+
+ elsif Found (FF) /= Expect (EF)
+ and then (Found (FF) /= Digit_0 or else Expect (EF) /= Letter_o)
+ then
+ return False;
+
+ -- Not a bad spelling if both strings are 1-2 characters long
+
+ elsif FN < 3 and then EN < 3 then
+ return False;
+
+ -- Lengths match. Execute loop to check for a single error, single
+ -- transposition or exact match (we only fall through this loop if
+ -- one of these three conditions is found).
+
+ elsif FN = EN then
+ for J in 1 .. FN - 2 loop
+ if Expect (EF + J) /= Found (FF + J) then
+
+ -- If both mismatched characters are digits, then we do
+ -- not consider it a misspelling (e.g. B345 is not a
+ -- misspelling of B346, it is something quite different)
+
+ if Expect (EF + J) in Digit_0 .. Digit_9
+ and then Found (FF + J) in Digit_0 .. Digit_9
+ then
+ return False;
+
+ elsif Expect (EF + J + 1) = Found (FF + J + 1)
+ and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
+ then
+ return True;
+
+ elsif Expect (EF + J) = Found (FF + J + 1)
+ and then Expect (EF + J + 1) = Found (FF + J)
+ and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
+ then
+ return True;
+
+ else
+ return False;
+ end if;
+ end if;
+ end loop;
+
+ -- At last character. Test digit case as above, otherwise we
+ -- have a match since at most this last character fails to match.
+
+ if Expect (EL) in Digit_0 .. Digit_9
+ and then Found (FL) in Digit_0 .. Digit_9
+ and then Expect (EL) /= Found (FL)
+ then
+ return False;
+ else
+ return True;
+ end if;
+
+ -- Length is 1 too short. Execute loop to check for single deletion
+
+ elsif FN = EN - 1 then
+ for J in 1 .. FN - 1 loop
+ if Found (FF + J) /= Expect (EF + J) then
+ return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
+ end if;
+ end loop;
+
+ -- If we fall through then the last character was missing, which
+ -- we consider to be a match (e.g. found xyz, expected xyza).
+
+ return True;
+
+ -- Length is 1 too long. Execute loop to check for single insertion
+
+ elsif FN = EN + 1 then
+ for J in 1 .. EN - 1 loop
+ if Found (FF + J) /= Expect (EF + J) then
+ return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
+ end if;
+ end loop;
+
+ -- If we fall through then the last character was an additional
+ -- character, which is a match (e.g. found xyza, expected xyz).
+
+ return True;
+
+ -- Length is completely wrong
+
+ else
+ return False;
+ end if;
+ end Is_Bad_Spelling_Of;
+
+end GNAT.Spelling_Checker_Generic;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- 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 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1998-2007, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Spelling checker
+
+-- This package provides a utility generic routine for checking for bad
+-- spellings. This routine must be instantiated with an appropriate array
+-- element type, which must represent a character encoding in which the
+-- codes for ASCII characters in the range 16#20#..16#7F# have their normal
+-- expected encoding values (e.g. the Pos value 16#31# must be digit 1).
+
+pragma Warnings (Off);
+pragma Compiler_Unit;
+pragma Warnings (On);
+
+package GNAT.Spelling_Checker_Generic is
+ pragma Pure;
+
+ generic
+ type Char_Type is (<>);
+ -- See above for restrictions on what types can be used here
+
+ type String_Type is array (Positive range <>) of Char_Type;
+
+ function Is_Bad_Spelling_Of
+ (Found : String_Type;
+ Expect : String_Type) return Boolean;
+ -- Determines if the string Found is a plausible misspelling of the string
+ -- Expect. Returns True for an exact match or a probably misspelling, False
+ -- if no near match is detected. This routine is case sensitive, so the
+ -- caller should fold both strings to get a case insensitive match if the
+ -- character encoding represents upper/lower case.
+ --
+ -- Note: the spec of this routine is deliberately rather vague. This
+ -- routine is the one used by GNAT itself to detect misspelled keywords
+ -- and identifiers, and is heuristically adjusted to be appropriate to
+ -- this usage. It will work well in any similar case of named entities.
+
+end GNAT.Spelling_Checker_Generic;
pragma Compiler_Unit;
pragma Warnings (On);
+with GNAT.Spelling_Checker_Generic;
+
package body GNAT.Spelling_Checker is
+ function IBS is new
+ GNAT.Spelling_Checker_Generic.Is_Bad_Spelling_Of
+ (Character, String);
+
------------------------
-- Is_Bad_Spelling_Of --
------------------------
function Is_Bad_Spelling_Of
(Found : String;
Expect : String) return Boolean
- is
- FN : constant Natural := Found'Length;
- FF : constant Natural := Found'First;
- FL : constant Natural := Found'Last;
-
- EN : constant Natural := Expect'Length;
- EF : constant Natural := Expect'First;
- EL : constant Natural := Expect'Last;
-
- begin
- -- If both strings null, then we consider this a match, but if one
- -- is null and the other is not, then we definitely do not match
-
- if FN = 0 then
- return (EN = 0);
-
- elsif EN = 0 then
- return False;
-
- -- If first character does not match, then we consider that this is
- -- definitely not a misspelling. An exception is when we expect a
- -- letter O and found a zero.
-
- elsif Found (FF) /= Expect (EF)
- and then (Found (FF) /= '0'
- or else (Expect (EF) /= 'o' and then Expect (EF) /= 'O'))
- then
- return False;
-
- -- Not a bad spelling if both strings are 1-2 characters long
-
- elsif FN < 3 and then EN < 3 then
- return False;
-
- -- Lengths match. Execute loop to check for a single error, single
- -- transposition or exact match (we only fall through this loop if
- -- one of these three conditions is found).
-
- elsif FN = EN then
- for J in 1 .. FN - 2 loop
- if Expect (EF + J) /= Found (FF + J) then
-
- -- If both mismatched characters are digits, then we do
- -- not consider it a misspelling (e.g. B345 is not a
- -- misspelling of B346, it is something quite different)
-
- if Expect (EF + J) in '0' .. '9'
- and then Found (FF + J) in '0' .. '9'
- then
- return False;
-
- elsif Expect (EF + J + 1) = Found (FF + J + 1)
- and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
- then
- return True;
-
- elsif Expect (EF + J) = Found (FF + J + 1)
- and then Expect (EF + J + 1) = Found (FF + J)
- and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
- then
- return True;
-
- else
- return False;
- end if;
- end if;
- end loop;
-
- -- At last character. Test digit case as above, otherwise we
- -- have a match since at most this last character fails to match.
-
- if Expect (EL) in '0' .. '9'
- and then Found (FL) in '0' .. '9'
- and then Expect (EL) /= Found (FL)
- then
- return False;
- else
- return True;
- end if;
-
- -- Length is 1 too short. Execute loop to check for single deletion
-
- elsif FN = EN - 1 then
- for J in 1 .. FN - 1 loop
- if Found (FF + J) /= Expect (EF + J) then
- return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
- end if;
- end loop;
-
- -- If we fall through then the last character was missing, which
- -- we consider to be a match (e.g. found xyz, expected xyza).
-
- return True;
-
- -- Length is 1 too long. Execute loop to check for single insertion
-
- elsif FN = EN + 1 then
- for J in 1 .. EN - 1 loop
- if Found (FF + J) /= Expect (EF + J) then
- return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
- end if;
- end loop;
-
- -- If we fall through then the last character was an additional
- -- character, which is a match (e.g. found xyza, expected xyz).
-
- return True;
-
- -- Length is completely wrong
-
- else
- return False;
- end if;
- end Is_Bad_Spelling_Of;
+ renames IBS;
end GNAT.Spelling_Checker;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- G N A T . U T F _ 3 2 _ S P E L L I N G _ C H E C K E R --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1998-2007, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+pragma Warnings (Off);
+pragma Compiler_Unit;
+pragma Warnings (On);
+
+with GNAT.Spelling_Checker_Generic;
+
+package body GNAT.UTF_32_Spelling_Checker is
+
+ function IBS is new
+ GNAT.Spelling_Checker_Generic.Is_Bad_Spelling_Of
+ (System.WCh_Cnv.UTF_32_Code, System.WCh_Cnv.UTF_32_String);
+
+ ------------------------
+ -- Is_Bad_Spelling_Of --
+ ------------------------
+
+ function Is_Bad_Spelling_Of
+ (Found : System.WCh_Cnv.UTF_32_String;
+ Expect : System.WCh_Cnv.UTF_32_String) return Boolean
+ renames IBS;
+
+end GNAT.UTF_32_Spelling_Checker;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- G N A T . U T F _ 3 2 _ S P E L L I N G _ C H E C K E R --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1998-2007, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Spelling checker
+
+-- This package provides a utility routine for checking for bad spellings
+-- for the case of System.WCh_Cnv.UTF_32_String arguments.
+
+pragma Warnings (Off);
+pragma Compiler_Unit;
+pragma Warnings (On);
+
+with System.WCh_Cnv;
+
+package GNAT.UTF_32_Spelling_Checker is
+ pragma Pure;
+
+ function Is_Bad_Spelling_Of
+ (Found : System.WCh_Cnv.UTF_32_String;
+ Expect : System.WCh_Cnv.UTF_32_String) return Boolean;
+ -- Determines if the string Found is a plausible misspelling of the string
+ -- Expect. Returns True for an exact match or a probably misspelling, False
+ -- if no near match is detected. This routine is case sensitive, so the
+ -- caller should fold both strings to get a case insensitive match.
+ --
+ -- Note: the spec of this routine is deliberately rather vague. It is used
+ -- by GNAT itself to detect misspelled keywords and identifiers, and is
+ -- heuristically adjusted to be appropriate to this usage. It will work
+ -- well in any similar case of named entities.
+
+end GNAT.UTF_32_Spelling_Checker;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- G N A T . W I D E _ S P E L L I N G _ C H E C K E R --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1998-2007, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with GNAT.Spelling_Checker_Generic;
+
+package body GNAT.Wide_Spelling_Checker is
+
+ function IBS is new
+ GNAT.Spelling_Checker_Generic.Is_Bad_Spelling_Of
+ (Wide_Character, Wide_String);
+
+ ------------------------
+ -- Is_Bad_Spelling_Of --
+ ------------------------
+
+ function Is_Bad_Spelling_Of
+ (Found : Wide_String;
+ Expect : Wide_String) return Boolean
+ renames IBS;
+
+end GNAT.Wide_Spelling_Checker;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- G N A T . W I D E _ S P E L L I N G _ C H E C K E R --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1998-2007, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Spelling checker
+
+-- This package provides a utility routine for checking for bad spellings
+-- for the case of Wide_String arguments.
+
+package GNAT.Wide_Spelling_Checker is
+ pragma Pure;
+
+ function Is_Bad_Spelling_Of
+ (Found : Wide_String;
+ Expect : Wide_String) return Boolean;
+ -- Determines if the string Found is a plausible misspelling of the string
+ -- Expect. Returns True for an exact match or a probably misspelling, False
+ -- if no near match is detected. This routine is case sensitive, so the
+ -- caller should fold both strings to get a case insensitive match.
+ --
+ -- Note: the spec of this routine is deliberately rather vague. It is used
+ -- by GNAT itself to detect misspelled keywords and identifiers, and is
+ -- heuristically adjusted to be appropriate to this usage. It will work
+ -- well in any similar case of named entities.
+
+end GNAT.Wide_Spelling_Checker;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- G N A T . W I D E _W I D E _ S P E L L I N G _ C H E C K E R --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1998-2007, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with GNAT.Spelling_Checker_Generic;
+
+package body GNAT.Wide_Wide_Spelling_Checker is
+
+ function IBS is new
+ GNAT.Spelling_Checker_Generic.Is_Bad_Spelling_Of
+ (Wide_Wide_Character, Wide_Wide_String);
+
+ ------------------------
+ -- Is_Bad_Spelling_Of --
+ ------------------------
+
+ function Is_Bad_Spelling_Of
+ (Found : Wide_Wide_String;
+ Expect : Wide_Wide_String) return Boolean
+ renames IBS;
+
+end GNAT.Wide_Wide_Spelling_Checker;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- G N A T . W I D E _ W I D E _ S P E L L I N G _ C H E C K E R --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1998-2007, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Spelling checker
+
+-- This package provides a utility routine for checking for bad spellings
+-- for the case of Wide_Wide_String arguments.
+
+package GNAT.Wide_Wide_Spelling_Checker is
+ pragma Pure;
+
+ function Is_Bad_Spelling_Of
+ (Found : Wide_Wide_String;
+ Expect : Wide_Wide_String) return Boolean;
+ -- Determines if the string Found is a plausible misspelling of the string
+ -- Expect. Returns True for an exact match or a probably misspelling, False
+ -- if no near match is detected. This routine is case sensitive, so the
+ -- caller should fold both strings to get a case insensitive match.
+ --
+ -- Note: the spec of this routine is deliberately rather vague. It is used
+ -- by GNAT itself to detect misspelled keywords and identifiers, and is
+ -- heuristically adjusted to be appropriate to this usage. It will work
+ -- well in any similar case of named entities.
+
+end GNAT.Wide_Wide_Spelling_Checker;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- N A M E T . S P --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2007, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.WCh_Cnv; use System.WCh_Cnv;
+
+with GNAT.UTF_32_Spelling_Checker;
+
+package body Namet.Sp is
+
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
+
+ procedure Get_Name_String_UTF_32
+ (Id : Name_Id;
+ Result : out UTF_32_String;
+ Length : out Natural);
+ -- This procedure is similar to Get_Decoded_Name except that the output
+ -- is stored in the given Result array as single codes, so in particular
+ -- any Uhh, Whhhh, or WWhhhhhhhh sequences are decoded to appear as a
+ -- single value in the output. This call does not affect the contents of
+ -- either Name_Buffer or Name_Len. The result is in Result (1 .. Length).
+ -- The caller must ensure that the result buffer is long enough.
+
+ ----------------------------
+ -- Get_Name_String_UTF_32 --
+ ----------------------------
+
+ procedure Get_Name_String_UTF_32
+ (Id : Name_Id;
+ Result : out UTF_32_String;
+ Length : out Natural)
+ is
+ pragma Assert (Result'First = 1);
+
+ SPtr : Int := Name_Entries.Table (Id).Name_Chars_Index + 1;
+ -- Index through characters of name in Name_Chars table. Initial value
+ -- points to first character of the name.
+
+ SLen : constant Nat := Nat (Name_Entries.Table (Id).Name_Len);
+ -- Length of the name
+
+ SLast : constant Int := SPtr + SLen - 1;
+ -- Last index in Name_Chars table for name
+
+ C : Character;
+ -- Current character from Name_Chars table
+
+ procedure Store_Hex (N : Natural);
+ -- Read and store next N characters starting at SPtr and store result
+ -- in next character of Result. Update SPtr past characters read.
+
+ ---------------
+ -- Store_Hex --
+ ---------------
+
+ procedure Store_Hex (N : Natural) is
+ T : UTF_32_Code;
+ C : Character;
+
+ begin
+ T := 0;
+ for J in 1 .. N loop
+ C := Name_Chars.Table (SPtr);
+ SPtr := SPtr + 1;
+
+ if C in '0' .. '9' then
+ T := 16 * T + Character'Pos (C) - Character'Pos ('0');
+ else
+ pragma Assert (C in 'a' .. 'f');
+
+ T := 16 * T + Character'Pos (C) - (Character'Pos ('a') - 10);
+ end if;
+ end loop;
+
+ Length := Length + 1;
+ pragma Assert (Length <= Result'Length);
+ Result (Length) := T;
+ end Store_Hex;
+
+ -- Start of processing for Get_Name_String_UTF_32
+
+ begin
+ Length := 0;
+ while SPtr <= SLast loop
+ C := Name_Chars.Table (SPtr);
+
+ -- Uhh encoding
+
+ if C = 'U'
+ and then SPtr <= SLast - 2
+ and then Name_Chars.Table (SPtr + 1) not in 'A' .. 'Z'
+ then
+ SPtr := SPtr + 1;
+ Store_Hex (2);
+
+ -- Whhhh encoding
+
+ elsif C = 'W'
+ and then SPtr <= SLast - 4
+ and then Name_Chars.Table (SPtr + 1) not in 'A' .. 'Z'
+ then
+ SPtr := SPtr + 1;
+ Store_Hex (4);
+
+ -- WWhhhhhhhh encoding
+
+ elsif C = 'W'
+ and then SPtr <= SLast - 8
+ and then Name_Chars.Table (SPtr + 1) = 'W'
+ then
+ SPtr := SPtr + 2;
+ Store_Hex (8);
+
+ -- Q encoding (character literal)
+
+ elsif C = 'Q' and then SPtr < SLast then
+
+ -- Put apostrophes around character
+
+ pragma Assert (Length <= Result'Last - 3);
+ Result (Length + 1) := UTF_32_Code'Val (Character'Pos ('''));
+ Result (Length + 2) :=
+ UTF_32_Code (Get_Char_Code (Name_Chars.Table (SPtr + 1)));
+ Result (Length + 3) := UTF_32_Code'Val (Character'Pos ('''));
+ SPtr := SPtr + 2;
+ Length := Length + 3;
+
+ -- Unencoded case
+
+ else
+ SPtr := SPtr + 1;
+ Length := Length + 1;
+ pragma Assert (Length <= Result'Last);
+ Result (Length) := UTF_32_Code (Get_Char_Code (C));
+ end if;
+ end loop;
+ end Get_Name_String_UTF_32;
+
+ ------------------------
+ -- Is_Bad_Spelling_Of --
+ ------------------------
+
+ function Is_Bad_Spelling_Of (Found, Expect : Name_Id) return Boolean is
+ FL : constant Natural := Natural (Length_Of_Name (Found));
+ EL : constant Natural := Natural (Length_Of_Name (Expect));
+ -- Length of input names
+
+ FB : UTF_32_String (1 .. 2 * FL);
+ EB : UTF_32_String (1 .. 2 * EL);
+ -- Buffers for results, a factor of 2 is more than enough, the only
+ -- sequence which expands is Q (character literal) by 1.5 times.
+
+ FBL : Natural;
+ EBL : Natural;
+ -- Length of decoded names
+
+ begin
+ Get_Name_String_UTF_32 (Found, FB, FBL);
+ Get_Name_String_UTF_32 (Expect, EB, EBL);
+ return
+ GNAT.UTF_32_Spelling_Checker.Is_Bad_Spelling_Of
+ (FB (1 .. FBL), EB (1 .. EBL));
+ end Is_Bad_Spelling_Of;
+
+end Namet.Sp;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- N A M E T - S P --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This child package contains a spell checker for Name_Id values. It is
+-- separated off as a child package, because of the extra dependencies,
+-- in particular on GNAT.UTF_32_ Spelling_Checker. There are a number of
+-- packages that use Namet that do not need the spell checking feature,
+-- and this separation helps in dealing with older versions of GNAT.
+
+package Namet.Sp is
+
+ function Is_Bad_Spelling_Of (Found, Expect : Name_Id) return Boolean;
+ -- Compares two identifier names from the names table, and returns True if
+ -- Found is a plausible misspelling of Expect. This function properly deals
+ -- with wide and wide wide character encodings in the input names.
+
+end Namet.Sp;
------------------------------------------------------------------------------
-- WARNING: There is a C version of this package. Any changes to this
--- source file must be properly reflected in the C header file a-namet.h
+-- source file must be properly reflected in the C header file namet.h
-- which is created manually from namet.ads and namet.adb.
with Debug; use Debug;
-- Search the map. Note that this loop must terminate, if
-- not we have some kind of internal error, and a constraint
- -- constraint error may be raised.
+ -- error may be raised.
J := Map'First;
loop
-- --
------------------------------------------------------------------------------
-with Stringt; use Stringt;
-with Uintp; use Uintp;
+with Namet.Sp; use Namet.Sp;
+with Stringt; use Stringt;
+with Uintp; use Uintp;
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
and then Chars (End_Labl) > Error_Name
and then Chars (Nam) > Error_Name
then
- Get_Name_String (Chars (End_Labl));
Error_Msg_Name_1 := Chars (Nam);
if Error_Msg_Name_1 > Error_Name then
- declare
- S : constant String (1 .. Name_Len) :=
- Name_Buffer (1 .. Name_Len);
-
- begin
- Get_Name_String (Error_Msg_Name_1);
-
- if Is_Bad_Spelling_Of
- (Name_Buffer (1 .. Name_Len), S)
- then
- Error_Msg_N ("misspelling of %", End_Labl);
- Syntax_OK := True;
- return;
- end if;
- end;
+ if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then
+ Error_Msg_Name_1 := Chars (Nam);
+ Error_Msg_N ("misspelling of %", End_Labl);
+ Syntax_OK := True;
+ return;
+ end if;
end if;
end if;
end;
with Fname.UF; use Fname.UF;
with Lib.Load; use Lib.Load;
+with Namet.Sp; use Namet.Sp;
with Uname; use Uname;
with Osint; use Osint;
with Sinput.L; use Sinput.L;
-- unit name is indeed a plausible misspelling of the one we got.
if Is_Bad_Spelling_Of
- (Found => Get_Name_String (Expect_Name),
- Expect => Get_Name_String (Actual_Name))
+ (Name_Id (Expect_Name), Name_Id (Actual_Name))
then
Error_Msg_Unit_1 := Actual_Name;
Error_Msg ("possible misspelling of $$!", Loc);
function Char_Sequence_To_UTF_32
(C : Character;
- EM : WC_Encoding_Method) return UTF_32_Code
+ EM : System.WCh_Con.WC_Encoding_Method) return UTF_32_Code
is
B1 : Unsigned_32;
C1 : Character;
raise Constraint_Error;
end if;
- W := Shift_Left (W, 6) or (U and 2#00111111#);
+ W := Shift_Left (W, 6) or (U and 2#00111111#);
end Get_UTF_Byte;
-- Start of processing for Char_Sequence_To_Wide
-- 16#00_0080#-16#00_07FF#: 110xxxxx 10xxxxxx
elsif (U and 2#11100000#) = 2#110_00000# then
- W := Shift_Left (U and 2#00011111#, 6);
- U := Unsigned_32 (Character'Pos (In_Char));
-
- if (U and 2#11000000#) /= 2#10_000000# then
- raise Constraint_Error;
- end if;
-
- W := W or (U and 2#00111111#);
-
+ W := U and 2#00011111#;
+ Get_UTF_Byte;
return UTF_32_Code (W);
-- 16#00_0800#-16#00_ffff#: 1110xxxx 10xxxxxx 10xxxxxx
end if;
when WCEM_Brackets =>
-
if C /= '[' then
return Character'Pos (C);
end if;
------------------------------------------------------------------------------
-- This package contains generic subprograms used for converting between
--- sequences of Character and Wide_Character. All access to wide character
--- sequences is isolated in this unit.
+-- sequences of Character and Wide_Character. Wide_Wide_Character values
+-- are also handled, but represented using integer range types defined in
+-- this package, so that this package can be used from applications that
+-- are restricted to Ada 95 compatibility (such as the compiler itself).
+
+-- All the algorithms for encoding and decoding are isolated in this package
+-- and in System.WCh_JIS and should not be duplicated elsewhere. The only
+-- exception to this is that GNAT.Decode_String and GNAT.Encode_String have
+-- their own circuits for UTF-8 conversions, for improved efficiency.
-- This unit may be used directly from an application program by providing
-- an appropriate WITH, and the interface can be expected to remain stable.
for UTF_32_Code'Size use 32;
-- Range of allowed UTF-32 encoding values
+ type UTF_32_String is array (Positive range <>) of UTF_32_Code;
+
generic
with function In_Char return Character;
function Char_Sequence_To_Wide_Char
-- corresponding wide character value. Constraint_Error is raised if the
-- sequence of characters encountered is not a valid wide character
-- sequence for the given encoding method.
+ --
+ -- Note on the use of brackets encoding (WCEM_Brackets). The brackets
+ -- encoding method is ambiguous in the context of this function, since
+ -- there is no way to tell if ["1234"] is eight unencoded characters or
+ -- one encoded character. In the context of Ada sources, any sequence
+ -- starting [" must be the start of an encoding (since that sequence is
+ -- not valid in Ada source otherwise). The routines in this package use
+ -- the same approach. If the input string contains the sequence [" then
+ -- this is assumed to be the start of a brackets encoding sequence, and
+ -- if it does not match the syntax, an error is raised.
generic
with function In_Char return Character;
-- more characters, calling the given Out_Char procedure for each.
-- Constraint_Error is raised if the given wide character value is
-- not a valid value for the given encoding method.
+ --
+ -- Note on brackets encoding (WCEM_Brackets). For the input routines above,
+ -- upper half characters can be represented as ["hh"] but this procedure
+ -- will only use brackets encodings for codes higher than 16#FF#, so upper
+ -- half characters will be output as single Character values.
generic
with procedure Out_Char (C : Character);
with Lib; use Lib;
with Lib.Xref; use Lib.Xref;
with Namet; use Namet;
+with Namet.Sp; use Namet.Sp;
with Nmake; use Nmake;
with Nlists; use Nlists;
with Opt; use Opt;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
-with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
-
package body Sem_Aggr is
type Case_Bounds is record
-- misspellings, these misspellings will be suggested as
-- possible correction.
- Get_Name_String (Chars (Component));
-
- declare
- S : constant String (1 .. Name_Len) :=
- Name_Buffer (1 .. Name_Len);
-
- begin
- Component_Elmt := First_Elmt (Elements);
- while Nr_Of_Suggestions <= Max_Suggestions
- and then Present (Component_Elmt)
- loop
- Get_Name_String (Chars (Node (Component_Elmt)));
-
- if Is_Bad_Spelling_Of (Name_Buffer (1 .. Name_Len), S) then
- Nr_Of_Suggestions := Nr_Of_Suggestions + 1;
+ Component_Elmt := First_Elmt (Elements);
+ while Nr_Of_Suggestions <= Max_Suggestions
+ and then Present (Component_Elmt)
+ loop
+ if Is_Bad_Spelling_Of
+ (Chars (Node (Component_Elmt)),
+ Chars (Component))
+ then
+ Nr_Of_Suggestions := Nr_Of_Suggestions + 1;
- case Nr_Of_Suggestions is
- when 1 => Suggestion_1 := Node (Component_Elmt);
- when 2 => Suggestion_2 := Node (Component_Elmt);
- when others => exit;
- end case;
- end if;
+ case Nr_Of_Suggestions is
+ when 1 => Suggestion_1 := Node (Component_Elmt);
+ when 2 => Suggestion_2 := Node (Component_Elmt);
+ when others => exit;
+ end case;
+ end if;
- Next_Elmt (Component_Elmt);
- end loop;
+ Next_Elmt (Component_Elmt);
+ end loop;
- -- Report at most two suggestions
+ -- Report at most two suggestions
- if Nr_Of_Suggestions = 1 then
- Error_Msg_NE ("\possible misspelling of&",
- Component, Suggestion_1);
+ if Nr_Of_Suggestions = 1 then
+ Error_Msg_NE
+ ("\possible misspelling of&", Component, Suggestion_1);
- elsif Nr_Of_Suggestions = 2 then
- Error_Msg_Node_2 := Suggestion_2;
- Error_Msg_NE ("\possible misspelling of& or&",
- Component, Suggestion_1);
- end if;
- end;
+ elsif Nr_Of_Suggestions = 2 then
+ Error_Msg_Node_2 := Suggestion_2;
+ Error_Msg_NE
+ ("\possible misspelling of& or&", Component, Suggestion_1);
+ end if;
end Check_Misspelled_Component;
----------------------------------------
-- A box-defaulted access component gets the value null. Also
-- included are components of private types whose underlying
- -- type is an access type.
+ -- type is an access type. In either case set the type of the
+ -- literal, for subsequent use in semantic checks.
elsif Present (Underlying_Type (Ctyp))
and then Is_Access_Type (Underlying_Type (Ctyp))
then
if not Is_Private_Type (Ctyp) then
+ Expr := Make_Null (Sloc (N));
+ Set_Etype (Expr, Ctyp);
Add_Association
(Component => Component,
- Expr => Make_Null (Sloc (N)));
+ Expr => Expr);
-- If the component's type is private with an access type as
-- its underlying type then we have to create an unchecked
-- Ignore hidden components associated with the position of the
-- interface tags: these are initialized dynamically.
- if Present (Related_Interface (Component)) then
- null;
- else
+ if not Present (Related_Type (Component)) then
Error_Msg_NE
("no value supplied for component &!", N, Component);
end if;
OSDN Git Service
