diff options
| -rwxr-xr-x | gcc/ada/g-spchge.adb | 165 | ||||
| -rwxr-xr-x | gcc/ada/g-spchge.ads | 69 | ||||
| -rw-r--r-- | gcc/ada/g-speche.adb | 121 | ||||
| -rwxr-xr-x | gcc/ada/g-u3spch.adb | 55 | ||||
| -rwxr-xr-x | gcc/ada/g-u3spch.ads | 61 | ||||
| -rwxr-xr-x | gcc/ada/g-wispch.adb | 51 | ||||
| -rwxr-xr-x | gcc/ada/g-wispch.ads | 55 | ||||
| -rwxr-xr-x | gcc/ada/g-zspche.adb | 51 | ||||
| -rwxr-xr-x | gcc/ada/g-zspche.ads | 55 | ||||
| -rwxr-xr-x | gcc/ada/namet-sp.adb | 196 | ||||
| -rwxr-xr-x | gcc/ada/namet-sp.ads | 47 | ||||
| -rw-r--r-- | gcc/ada/namet.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/par-endh.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/par-load.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-wchcnv.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/s-wchcnv.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 73 |
17 files changed, 888 insertions, 190 deletions
diff --git a/gcc/ada/g-spchge.adb b/gcc/ada/g-spchge.adb new file mode 100755 index 00000000000..2e4c7c786fb --- /dev/null +++ b/gcc/ada/g-spchge.adb @@ -0,0 +1,165 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/g-spchge.ads b/gcc/ada/g-spchge.ads new file mode 100755 index 00000000000..0a29c589a21 --- /dev/null +++ b/gcc/ada/g-spchge.ads @@ -0,0 +1,69 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/g-speche.adb b/gcc/ada/g-speche.adb index 72c0abcfacc..841eef8ddfe 100644 --- a/gcc/ada/g-speche.adb +++ b/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; diff --git a/gcc/ada/g-u3spch.adb b/gcc/ada/g-u3spch.adb new file mode 100755 index 00000000000..3e7ede843f2 --- /dev/null +++ b/gcc/ada/g-u3spch.adb @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/g-u3spch.ads b/gcc/ada/g-u3spch.ads new file mode 100755 index 00000000000..90ab66d978f --- /dev/null +++ b/gcc/ada/g-u3spch.ads @@ -0,0 +1,61 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/g-wispch.adb b/gcc/ada/g-wispch.adb new file mode 100755 index 00000000000..0fc0ff6f227 --- /dev/null +++ b/gcc/ada/g-wispch.adb @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/g-wispch.ads b/gcc/ada/g-wispch.ads new file mode 100755 index 00000000000..09c57ed41c8 --- /dev/null +++ b/gcc/ada/g-wispch.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/g-zspche.adb b/gcc/ada/g-zspche.adb new file mode 100755 index 00000000000..1b7b3ff29d8 --- /dev/null +++ b/gcc/ada/g-zspche.adb @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/g-zspche.ads b/gcc/ada/g-zspche.ads new file mode 100755 index 00000000000..217eab6f528 --- /dev/null +++ b/gcc/ada/g-zspche.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/namet-sp.adb b/gcc/ada/namet-sp.adb new file mode 100755 index 00000000000..fd19d4991c5 --- /dev/null +++ b/gcc/ada/namet-sp.adb @@ -0,0 +1,196 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/namet-sp.ads b/gcc/ada/namet-sp.ads new file mode 100755 index 00000000000..014c9357d18 --- /dev/null +++ b/gcc/ada/namet-sp.ads @@ -0,0 +1,47 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 6d5d1580f30..7d5c28b745d 100644 --- a/gcc/ada/namet.adb +++ b/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 diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index d1dcfa3e746..59fa37fc73a 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -23,8 +23,9 @@ -- -- ------------------------------------------------------------------------------ -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; @@ -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 - 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; diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb index 711031b4d8a..4f77f7d32b9 100644 --- a/gcc/ada/par-load.adb +++ b/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); diff --git a/gcc/ada/s-wchcnv.adb b/gcc/ada/s-wchcnv.adb index b58290f764b..3e877aaec98 100644 --- a/gcc/ada/s-wchcnv.adb +++ b/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; @@ -94,7 +94,7 @@ package body System.WCh_Cnv is 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 @@ -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; diff --git a/gcc/ada/s-wchcnv.ads b/gcc/ada/s-wchcnv.ads index 5c3459f4c26..3679b881a56 100644 --- a/gcc/ada/s-wchcnv.ads +++ b/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); diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 3d5b62df4cf..f6ae6e56276 100644 --- a/gcc/ada/sem_aggr.adb +++ b/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,44 +729,37 @@ 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 - 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; ---------------------------------------- @@ -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; |