From: Bob Duff <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch5.adb | 31 +++++++++++++++----------------
gcc/ada/exp_ch7.adb | 14 --------------
gcc/ada/sem_warn.adb | 9 +++++++--
3 files changed, 22 insertions(+), 32 deletions(-)
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 0949d5864bb..10744945ca7 100644
--- 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 600d333952c..8c661900b06 100644
--- 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 156afc92307..f085149a15d 100644
--- 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;
--
2.51.0
