[multiple changes]

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*).

From-SVN: r192927
This commit is contained in:
Arnaud Charlet 2012-10-29 11:56:44 +01:00
parent f0b741b6e7
commit 0cc71b488a
9 changed files with 83 additions and 34 deletions

View File

@ -1,3 +1,24 @@
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

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -137,12 +137,14 @@ package body Ch11 is
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

View File

@ -243,6 +243,13 @@ package body Ch3 is
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;
@ -3191,6 +3198,7 @@ package body Ch3 is
Rec_Node : Node_Id;
begin
Inside_Record_Definition := True;
Rec_Node := New_Node (N_Record_Definition, Token_Ptr);
-- Null record case
@ -3235,6 +3243,7 @@ package body Ch3 is
end loop;
end if;
Inside_Record_Definition := False;
return Rec_Node;
end P_Record_Definition;

View File

@ -1139,6 +1139,7 @@ package body Ch6 is
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
@ -1176,6 +1177,7 @@ package body Ch6 is
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
@ -1667,6 +1669,7 @@ package body Ch6 is
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);

View File

@ -27,6 +27,7 @@ with Csets; use Csets;
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;
@ -762,4 +763,21 @@ package body Util is
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;

View File

@ -59,7 +59,7 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
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
@ -67,7 +67,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
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 --
@ -1264,6 +1268,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
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;
--------------

View File

@ -12804,25 +12804,30 @@ package body Sem_Ch3 is
-- 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)));
@ -12846,7 +12851,7 @@ package body Sem_Ch3 is
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)));
@ -12873,7 +12878,7 @@ package body Sem_Ch3 is
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
@ -12896,7 +12901,7 @@ package body Sem_Ch3 is
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))

View File

@ -31,10 +31,7 @@
-- 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
@ -74,20 +71,6 @@ 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;

View File

@ -236,7 +236,6 @@ package body Warnsw is
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;