[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

gcc/ada/ChangeLog

+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

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

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;
 

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);
 

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;

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;
 
    --------------

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

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;

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;