* warnsw.adb (Set_GNAT_Mode_Warnings): Unset
Warn_On_Standard_Redefinition.
2012-10-29 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Derive_Progenitor_Subprograms): Complete documentation.
2012-10-29 Robert Dewar <dewar@adacore.com>
* par-ch11.adb (Warn_If_Standard_Redefinition): Add calls.
* par-ch3.adb (P_Defining_Identifier): Call
Warn_If_Standard_Redefinition if not inside record definition.
* par-ch6.adb (Warn_If_Standard_Redefinition): Add calls.
* par-util.adb (Warn_If_Standard_Redefinition): New procedure.
* par.adb (Inside_Record_Definition): New flag.
(Warn_If_Standard_Redefinition): New procedure.
* sinfo-cn.adb (Change_Identifier_To_Defining_Identifier): Remove
handling of warning for redefining standard name (moved to Par*).
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@192927
138bc75d-0d04-0410-961f-
82ee72b054a4
+2012-10-29 Arnaud Charlet <charlet@adacore.com>
+
+ * warnsw.adb (Set_GNAT_Mode_Warnings): Unset
+ Warn_On_Standard_Redefinition.
+
+2012-10-29 Javier Miranda <miranda@adacore.com>
+
+ * sem_ch3.adb (Derive_Progenitor_Subprograms): Complete documentation.
+
+2012-10-29 Robert Dewar <dewar@adacore.com>
+
+ * par-ch11.adb (Warn_If_Standard_Redefinition): Add calls.
+ * par-ch3.adb (P_Defining_Identifier): Call
+ Warn_If_Standard_Redefinition if not inside record definition.
+ * par-ch6.adb (Warn_If_Standard_Redefinition): Add calls.
+ * par-util.adb (Warn_If_Standard_Redefinition): New procedure.
+ * par.adb (Inside_Record_Definition): New flag.
+ (Warn_If_Standard_Redefinition): New procedure.
+ * sinfo-cn.adb (Change_Identifier_To_Defining_Identifier): Remove
+ handling of warning for redefining standard name (moved to Par*).
+
2012-10-29 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Derive_Progenitor_Subprograms): Disable small
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
Scan; -- past :
Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
+ Warn_If_Standard_Redefinition (Choice_Param_Node);
Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
elsif Token = Tok_Others then
Error_Msg_AP -- CODEFIX
("missing "":""");
Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
+ Warn_If_Standard_Redefinition (Choice_Param_Node);
Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
else
if Ident_Node /= Error then
Change_Identifier_To_Defining_Identifier (Ident_Node);
+
+ -- Warn if standard redefinition, except that we never warn on a
+ -- record field definition (since this is always a harmless case).
+
+ if not Inside_Record_Definition then
+ Warn_If_Standard_Redefinition (Ident_Node);
+ end if;
end if;
return Ident_Node;
Rec_Node : Node_Id;
begin
+ Inside_Record_Definition := True;
Rec_Node := New_Node (N_Record_Definition, Token_Ptr);
-- Null record case
end loop;
end if;
+ Inside_Record_Definition := False;
return Rec_Node;
end P_Record_Definition;
if Token /= Tok_Dot then
Change_Identifier_To_Defining_Identifier (Ident_Node);
+ Warn_If_Standard_Redefinition (Ident_Node);
return Ident_Node;
-- Child library unit name case
Change_Node (Prefix_Node, N_Defining_Program_Unit_Name);
Set_Name (Prefix_Node, Name_Node);
Change_Identifier_To_Defining_Identifier (Ident_Node);
+ Warn_If_Standard_Redefinition (Ident_Node);
Set_Defining_Identifier (Prefix_Node, Ident_Node);
-- All set with unit name parsed
begin
Return_Obj := Token_Node;
Change_Identifier_To_Defining_Identifier (Return_Obj);
+ Warn_If_Standard_Redefinition (Return_Obj);
Decl_Node := New_Node (N_Object_Declaration, Token_Ptr);
Set_Defining_Identifier (Decl_Node, Return_Obj);
with Namet.Sp; use Namet.Sp;
with Stylesw; use Stylesw;
with Uintp; use Uintp;
+with Warnsw; use Warnsw;
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
return (Token_Ptr = First_Non_Blank_Location or else Token = Tok_EOF);
end Token_Is_At_Start_Of_Line;
+ -----------------------------------
+ -- Warn_If_Standard_Redefinition --
+ -----------------------------------
+
+ procedure Warn_If_Standard_Redefinition (N : Node_Id) is
+ begin
+ if Warn_On_Standard_Redefinition then
+ declare
+ C : constant Entity_Id := Current_Entity (N);
+ begin
+ if Present (C) and then Sloc (C) = Standard_Location then
+ Error_Msg_N ("redefinition of entity& in Standard?", N);
+ end if;
+ end;
+ end if;
+ end Warn_If_Standard_Redefinition;
+
end Util;
Num_Library_Units : Natural := 0;
-- Count number of units parsed (relevant only in syntax check only mode,
- -- since in semantics check mode only a single unit is permitted anyway)
+ -- since in semantics check mode only a single unit is permitted anyway).
Save_Config_Switches : Config_Switches_Type;
-- Variable used to save values of config switches while we parse the
Loop_Block_Count : Nat := 0;
-- Counter used for constructing loop/block names (see the routine
- -- Par.Ch5.Get_Loop_Block_Name)
+ -- Par.Ch5.Get_Loop_Block_Name).
+
+ Inside_Record_Definition : Boolean := False;
+ -- Flag set True within a record definition. Used to control warning
+ -- for redefinition of standard entities (not issued for field names).
--------------------
-- Error Recovery --
function Token_Is_At_End_Of_Line return Boolean;
-- Determines if the current token is the last token on the line
+ procedure Warn_If_Standard_Redefinition (N : Node_Id);
+ -- Issues a warning if Warn_On_Standard_Redefinition is set True, and
+ -- the Node N (which is a Defining_Identifier node with the Chars field
+ -- set) is a renaming of an entity in package Standard.
+
end Util;
--------------
-- done here because interfaces must be visible in the partial and
-- private view (RM 7.3(7.3/2)).
- -- Small optimization: This work is only required if the parent
- -- is abstract or a generic formal type. If the tagged type is not
- -- abstract, it cannot have abstract primitives (the only entities
- -- in the list of primitives of non-abstract tagged types that can
- -- reference abstract primitives through its Alias attribute are the
- -- internal entities that have attribute Interface_Alias, and these
- -- entities are generated later by Add_Internal_Interface_Entities).
- -- Need explanation for the generic case ???
+ -- Small optimization: This work is only required if the parent may
+ -- have entities whose Alias attribute reference an interface primitive.
+ -- Such a situation may occur if the parent is an abstract type and the
+ -- primitive has not been yet overridden or if the parent is a generic
+ -- formal type covering interfaces.
+
+ -- If the tagged type is not abstract, it cannot have abstract
+ -- primitives (the only entities in the list of primitives of
+ -- non-abstract tagged types that can reference abstract primitives
+ -- through its Alias attribute are the internal entities that have
+ -- attribute Interface_Alias, and these entities are generated later
+ -- by Add_Internal_Interface_Entities).
if In_Private_Part (Current_Scope)
and then (Is_Abstract_Type (Parent_Type)
- or else Is_Generic_Type (Parent_Type))
+ or else
+ Is_Generic_Type (Parent_Type))
then
Elmt := First_Elmt (Primitive_Operations (Tagged_Type));
while Present (Elmt) loop
Subp := Node (Elmt);
-- At this stage it is not possible to have entities in the list
- -- of primitives that have attribute Interface_Alias
+ -- of primitives that have attribute Interface_Alias.
pragma Assert (No (Interface_Alias (Subp)));
end if;
-- Step 2: Add primitives of progenitors that are not implemented by
- -- parents of Tagged_Type
+ -- parents of Tagged_Type.
if Present (Interfaces (Base_Type (Tagged_Type))) then
Iface_Elmt := First_Elmt (Interfaces (Base_Type (Tagged_Type)));
Iface_Prim => Iface_Subp);
-- If not found we derive a new primitive leaving its alias
- -- attribute referencing the interface primitive
+ -- attribute referencing the interface primitive.
if No (E) then
Derive_Subprogram
Is_Abstract_Subprogram (E));
-- Propagate to the full view interface entities associated
- -- with the partial view
+ -- with the partial view.
elsif In_Private_Part (Current_Scope)
and then Present (Alias (E))
-- have been deliberately layed out in a manner that permits such alteration.
with Atree; use Atree;
-with Errout; use Errout;
-with Sem_Util; use Sem_Util;
with Snames; use Snames;
-with Warnsw; use Warnsw;
package body Sinfo.CN is
procedure Change_Identifier_To_Defining_Identifier (N : in out Node_Id) is
begin
- -- Check for redefinition of standard entity (requiring a warning)
-
- if Warn_On_Standard_Redefinition then
- declare
- C : constant Entity_Id := Current_Entity (N);
- begin
- if Present (C) and then Sloc (C) = Standard_Location then
- Error_Msg_N ("redefinition of entity& in Standard?", N);
- end if;
- end;
- end if;
-
- -- Go ahead with the change
-
Set_Nkind (N, N_Defining_Identifier);
N := Extend_Node (N);
end Change_Identifier_To_Defining_Identifier;
Warn_On_Record_Holes := False;
Warn_On_Redundant_Constructs := True;
Warn_On_Reverse_Bit_Order := False;
- Warn_On_Standard_Redefinition := True;
Warn_On_Suspicious_Contract := True;
Warn_On_Unchecked_Conversion := True;
Warn_On_Unordered_Enumeration_Type := False;
projects / thirdparty / gcc.git / commitdiff
