diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/styleg-c.adb')
-rw-r--r-- | gcc-4.2.1/gcc/ada/styleg-c.adb | 225 |
1 files changed, 0 insertions, 225 deletions
diff --git a/gcc-4.2.1/gcc/ada/styleg-c.adb b/gcc-4.2.1/gcc/ada/styleg-c.adb deleted file mode 100644 index d9c104910..000000000 --- a/gcc-4.2.1/gcc/ada/styleg-c.adb +++ /dev/null @@ -1,225 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S T Y L E G . C -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2005 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. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Atree; use Atree; -with Casing; use Casing; -with Csets; use Csets; -with Einfo; use Einfo; -with Err_Vars; use Err_Vars; -with Namet; use Namet; -with Sinfo; use Sinfo; -with Sinput; use Sinput; -with Stand; use Stand; -with Stylesw; use Stylesw; - -package body Styleg.C is - - ----------------------- - -- Body_With_No_Spec -- - ----------------------- - - -- If the check specs mode (-gnatys) is set, then all subprograms must - -- have specs unless they are parameterless procedures that are not child - -- units at the library level (i.e. they are possible main programs). - - procedure Body_With_No_Spec (N : Node_Id) is - begin - if Style_Check_Specs then - if Nkind (Parent (N)) = N_Compilation_Unit then - declare - Spec : constant Node_Id := Specification (N); - Defnm : constant Node_Id := Defining_Unit_Name (Spec); - - begin - if Nkind (Spec) = N_Procedure_Specification - and then Nkind (Defnm) = N_Defining_Identifier - and then No (First_Formal (Defnm)) - then - return; - end if; - end; - end if; - - Error_Msg_N ("(style) subprogram body has no previous spec", N); - end if; - end Body_With_No_Spec; - - ---------------------- - -- Check_Identifier -- - ---------------------- - - -- In check references mode (-gnatyr), identifier uses must be cased - -- the same way as the corresponding identifier declaration. - - procedure Check_Identifier - (Ref : Node_Or_Entity_Id; - Def : Node_Or_Entity_Id) - is - Sref : Source_Ptr := Sloc (Ref); - Sdef : Source_Ptr := Sloc (Def); - Tref : Source_Buffer_Ptr; - Tdef : Source_Buffer_Ptr; - Nlen : Nat; - Cas : Casing_Type; - - begin - -- If reference does not come from source, nothing to check - - if not Comes_From_Source (Ref) then - return; - - -- If previous error on either node/entity, ignore - - elsif Error_Posted (Ref) or else Error_Posted (Def) then - return; - - -- Case of definition comes from source - - elsif Comes_From_Source (Def) then - - -- Check same casing if we are checking references - - if Style_Check_References then - Tref := Source_Text (Get_Source_File_Index (Sref)); - Tdef := Source_Text (Get_Source_File_Index (Sdef)); - - -- Ignore operator name case completely. This also catches the - -- case of where one is an operator and the other is not. This - -- is a phenomenon from rewriting of operators as functions, - -- and is to be ignored. - - if Tref (Sref) = '"' or else Tdef (Sdef) = '"' then - return; - - else - while Tref (Sref) = Tdef (Sdef) loop - - -- If end of identifier, all done - - if not Identifier_Char (Tref (Sref)) then - return; - - -- Otherwise loop continues - - else - Sref := Sref + 1; - Sdef := Sdef + 1; - end if; - end loop; - - -- Fall through loop when mismatch between identifiers - -- If either identifier is not terminated, error. - - if Identifier_Char (Tref (Sref)) - or else - Identifier_Char (Tdef (Sdef)) - then - Error_Msg_Node_1 := Def; - Error_Msg_Sloc := Sloc (Def); - Error_Msg - ("(style) bad casing of & declared#", Sref); - return; - - -- Else end of identifiers, and they match - - else - return; - end if; - end if; - end if; - - -- Case of definition in package Standard - - elsif Sdef = Standard_Location then - - -- Check case of identifiers in Standard - - if Style_Check_Standard then - Tref := Source_Text (Get_Source_File_Index (Sref)); - - -- Ignore operators - - if Tref (Sref) = '"' then - null; - - -- Otherwise determine required casing of Standard entity - - else - -- ASCII entities are in all upper case - - if Entity (Ref) = Standard_ASCII then - Cas := All_Upper_Case; - - -- Special names in ASCII are also all upper case - - elsif Entity (Ref) in SE (S_LC_A) .. SE (S_LC_Z) - or else - Entity (Ref) in SE (S_NUL) .. SE (S_US) - or else - Entity (Ref) = SE (S_DEL) - then - Cas := All_Upper_Case; - - -- All other entities are in mixed case - - else - Cas := Mixed_Case; - end if; - - Nlen := Length_Of_Name (Chars (Ref)); - - -- Now check if we have the right casing - - if Determine_Casing - (Tref (Sref .. Sref + Source_Ptr (Nlen) - 1)) = Cas - then - null; - else - Name_Len := Integer (Nlen); - Name_Buffer (1 .. Name_Len) := - String (Tref (Sref .. Sref + Source_Ptr (Nlen) - 1)); - Set_Casing (Cas); - Error_Msg_Name_1 := Name_Enter; - Error_Msg_N - ("(style) bad casing of { declared in Standard", Ref); - end if; - end if; - end if; - end if; - end Check_Identifier; - - ----------------------------------- - -- Subprogram_Not_In_Alpha_Order -- - ----------------------------------- - - procedure Subprogram_Not_In_Alpha_Order (Name : Node_Id) is - begin - if Style_Check_Order_Subprograms then - Error_Msg_N - ("(style) subprogram body& not in alphabetical order", Name); - end if; - end Subprogram_Not_In_Alpha_Order; -end Styleg.C; |