Skip to content

R
riscv-gcc-1
Commit c80d4855 by Robert Dewar Committed by Arnaud Charlet
Options

g-spchge.ads, [...]: New files. 

2007-12-06  Robert Dewar  <dewar@adacore.com>

	* g-spchge.ads, g-spchge.adb, g-u3spch.adb, g-u3spch.ads,
	g-wispch.adb, g-wispch.ads, g-zspche.adb, g-zspche.ads,
	namet-sp.adb, namet-sp.ads: New files.

	* g-speche.adb: Use generic routine in g-spchge

	* s-wchcnv.ads, s-wchcnv.adb: 
	Minor code cleanup (make formal type consistent with spec)

	* namet.adb: Update comments.

	* par-endh.adb (Evaluate_End_Entry): Use new
	Namet.Sp.Is_Bad_Spelling_Of function

	* par-load.adb (Load): Use new Namet.Sp.Is_Bad_Spelling_Of function

	* sem_aggr.adb (Resolve_Record_Aggregate): If a component of an
	ancestor is an access type initialized with a box, set its type
	explicitly, for use in subsequent expansion.
	(Check_Misspelled_Component): Use new Namet.Sp.Is_Bad_Spelling_Of
	function

From-SVN: r130843
parent 1fdc61b5
Showing with 863 additions and 165 deletions
gcc/ada/g-spchge.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/g-spchge.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/g-speche.adb
......@@ -35,8 +35,14 @@ pragma Warnings (Off);
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 --
------------------------
......@@ -44,119 +50,6 @@ package body GNAT.Spelling_Checker is
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;
gcc/ada/g-u3spch.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/g-u3spch.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/g-wispch.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/g-wispch.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/g-zspche.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/g-zspche.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/namet-sp.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/namet-sp.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/namet.adb
......@@ -32,7 +32,7 @@
------------------------------------------------------------------------------
-- 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;
......@@ -444,7 +444,7 @@ package body Namet is
-- 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
......
gcc/ada/par-endh.adb
......@@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Namet.Sp; use Namet.Sp;
with Stringt; use Stringt;
with Uintp; use Uintp;
......@@ -711,25 +712,15 @@ package body Endh is
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
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;
end if;
end if;
end;
......
gcc/ada/par-load.adb
......@@ -31,6 +31,7 @@
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;
......@@ -225,8 +226,7 @@ begin
-- 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);
......
gcc/ada/s-wchcnv.adb
......@@ -47,7 +47,7 @@ package body System.WCh_Cnv is
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;
......@@ -151,15 +151,8 @@ package body System.WCh_Cnv is
-- 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
......@@ -210,7 +203,6 @@ package body System.WCh_Cnv is
end if;
when WCEM_Brackets =>
if C /= '[' then
return Character'Pos (C);
end if;
......
gcc/ada/s-wchcnv.ads
......@@ -32,8 +32,15 @@
------------------------------------------------------------------------------
-- 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.
......@@ -51,6 +58,8 @@ package System.WCh_Cnv is
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
......@@ -62,6 +71,16 @@ package System.WCh_Cnv is
-- 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;
......@@ -82,6 +101,11 @@ package System.WCh_Cnv is
-- 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);
......
gcc/ada/sem_aggr.adb
......@@ -35,6 +35,7 @@ with Itypes; use Itypes;
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;
......@@ -55,8 +56,6 @@ with Targparm; use Targparm;
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
......@@ -730,20 +729,14 @@ package body Sem_Aggr is
-- 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
if Is_Bad_Spelling_Of
(Chars (Node (Component_Elmt)),
Chars (Component))
then
Nr_Of_Suggestions := Nr_Of_Suggestions + 1;
case Nr_Of_Suggestions is
......@@ -759,15 +752,14 @@ package body Sem_Aggr is
-- Report at most two suggestions
if Nr_Of_Suggestions = 1 then
Error_Msg_NE ("\possible misspelling of&",
Component, Suggestion_1);
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);
Error_Msg_NE
("\possible misspelling of& or&", Component, Suggestion_1);
end if;
end;
end Check_Misspelled_Component;
----------------------------------------
......@@ -3029,15 +3021,18 @@ package body Sem_Aggr is
-- 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
......@@ -3184,9 +3179,7 @@ package body Sem_Aggr is
-- 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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment