aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.2.1/gcc/ada/styleg-c.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.2.1/gcc/ada/styleg-c.adb')
-rw-r--r--gcc-4.2.1/gcc/ada/styleg-c.adb225
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;