diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/ada/par-ch11.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/par-ch3.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/par-ch6.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/par-util.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/par.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/sinfo-cn.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/warnsw.adb | 1 |
9 files changed, 83 insertions, 34 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3d26ada..76b143d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb index a11894c..c255325 100644 --- a/gcc/ada/par-ch11.adb +++ b/gcc/ada/par-ch11.adb @@ -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 diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index bfc4f59..728a704 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -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; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 4f6ccb5..c0fc773 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -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); diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index efcf70b..0c23f93 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -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; diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 486c0f3..571713f 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -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; -------------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index bb3937e..a3b7f3e 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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)) diff --git a/gcc/ada/sinfo-cn.adb b/gcc/ada/sinfo-cn.adb index 60afa01..f581eaa 100644 --- a/gcc/ada/sinfo-cn.adb +++ b/gcc/ada/sinfo-cn.adb @@ -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; diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 3b42857..7920ac9 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -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; |