ada: Avoid incorrect errors for duplicate formal iterator names

This patch fixes the following bug: If a type has an Iterable aspect
(as in the formal containers), and two or more cursor loops of the
form "for C in ..."  occur in the same scope, and the cursor type has
discriminants without defaults, the compiler complains incorrectly
about duplicate names "Tc".

This is because the generated declaration of the C object was being
analyzed in the wrong scope. In the discriminated case, an internal
subtype name TcS is generated for each C. Errout "helpfully" removes "S"
in the error message, resulting in a complaint about "Tc".  The fix is
to push the correct scope (that of the generated surrounding block
statement) when analyzing the declaration of C.

gcc/ada/ChangeLog:

	* exp_ch5.adb (Expand_Formal_Container_Loop):
	Analyze Init_Decl in the correct scope. Remove patch-up
	code that was needed because we were using the wrong scope.
	* exp_ch7.adb (Process_Object_Declaration):
	Remove code to unique-ify the name of Master_Node_Id;
	no longer needed because of change to exp_ch5.adb.
	* sem_warn.adb (Check_References):
	Suppress warnings during preanalysis, because we don't
	have complete information yet; otherwise, the new Preanalyze
	call in exp_ch5.adb generates bogus warnings.

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 0949d5864bb5eeebabeec307f15790c3f47151fd..10744945ca7b9366b13c0a912bcef0691fa6807f 100644 (file)
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -168,11 +168,12 @@ package body Exp_Ch5 is
    --  a procedure with an in-out parameter, and expanded as such.
 
    procedure Expand_Formal_Container_Loop (N : Node_Id);
-   --  Use the primitives specified in an Iterable aspect to expand a loop
-   --  over a so-called formal container, primarily for SPARK usage.
+   --  Use the primitives specified in an Iterable aspect to expand a loop.
+   --  The Iterable aspect is used by the SPARK formal containers, and can
+   --  also be used by user code.
 
    procedure Expand_Formal_Container_Element_Loop (N : Node_Id);
-   --  Same, for an iterator of the form " For E of C". In this case the
+   --  Same, for an iterator of the form "for E of C". In this case the
    --  iterator provides the name of the element, and the cursor is generated
    --  internally.
 
@@ -4549,10 +4550,15 @@ package body Exp_Ch5 is
             Make_Handled_Sequence_Of_Statements (Loc,
               Statements => New_List (New_Loop))));
 
-      --  The loop parameter is declared by an object declaration, but within
-      --  the loop we must prevent user assignments to it, so we analyze the
-      --  declaration and reset the entity kind, before analyzing the rest of
-      --  the loop.
+      --  The loop parameter is declared by an object declaration (Init_Decl),
+      --  but within the loop we must prevent user assignments to it, so we
+      --  analyze Init_Decl and reset the entity kind, before analyzing the
+      --  rest of the loop. First Preanalyze the block statement, to set its
+      --  Identifier, and then push that as the scope in which to analyze
+      --  Init_Decl.
+
+      Preanalyze (N);
+      Push_Scope (Entity (Identifier (N)));
 
       Analyze (Init_Decl);
       Init_Name := Defining_Identifier (Init_Decl);
@@ -4564,6 +4570,8 @@ package body Exp_Ch5 is
       Reinit_Field_To_Zero (Init_Name, F_SPARK_Pragma_Inherited);
       Mutate_Ekind (Init_Name, E_Loop_Parameter);
 
+      Pop_Scope;
+
       --  Wrap the block statements with the condition specified in the
       --  iterator filter when one is present.
 
@@ -4583,15 +4591,6 @@ package body Exp_Ch5 is
 
       Set_Assignment_OK (Name (Advance));
       Analyze (N);
-
-      --  Because we have to analyze the initial declaration of the loop
-      --  parameter multiple times its scope is incorrectly set at this point
-      --  to the one surrounding the block statement - so set the scope
-      --  manually to be the actual block statement, and indicate that it is
-      --  not visible after the block has been analyzed.
-
-      Set_Scope (Init_Name, Entity (Identifier (N)));
-      Set_Is_Immediately_Visible (Init_Name, False);
    end Expand_Formal_Container_Loop;
 
    ------------------------------------------

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 600d333952c499db508fd4ede74efa1ff95228ce..8c661900b06f529885be5825db6272413e17bef9 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2727,8 +2727,6 @@ package body Exp_Ch7 is
          Obj_Ref            : Node_Id;
          Obj_Typ            : Entity_Id;
 
-      --  Start of processing for Process_Object_Declaration
-
       begin
          --  Handle the object type and the reference to the object. Note
          --  that objects having simple protected components or of a CW type
@@ -2789,18 +2787,6 @@ package body Exp_Ch7 is
 
             Push_Scope (Scope (Obj_Id));
 
-            --  Avoid generating duplicate names for master nodes
-
-            if Ekind (Obj_Id) = E_Loop_Parameter
-              and then
-                Present (Current_Entity_In_Scope (Chars (Master_Node_Id)))
-            then
-               Set_Chars (Master_Node_Id,
-                 New_External_Name (Chars (Obj_Id),
-                   Suffix => "MN",
-                   Suffix_Index => -1));
-            end if;
-
             if not Has_Strict_Ctrl_Objs or else Count = 1 then
                Prepend_To (Decls, Master_Node_Decl);
             else

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 156afc923075219cdd454292846135e1b3fa7ef7..f085149a15dd0f975c9030dc1dbb639ee925750d 100644 (file)
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1207,9 +1207,14 @@ package body Sem_Warn is
    begin
       --  No messages if warnings are suppressed, or if we have detected any
       --  real errors so far (this last check avoids junk messages resulting
-      --  from errors, e.g. a subunit that is not loaded).
+      --  from errors, e.g. a subunit that is not loaded). No messages if
+      --  we are in preanalysis (warnings will be detected properly later,
+      --  during analysis).
 
-      if Warning_Mode = Suppress or else Serious_Errors_Detected /= 0 then
+      if Warning_Mode = Suppress
+        or else Serious_Errors_Detected /= 0
+        or else not Full_Analysis
+      then
          return;
       end if;