This patch corrects the previous messy and erroneous analysis of quantified
expression.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-03-15 Vincent Pucci <pu...@adacore.com>
* exp_ch4.adb (Expand_N_Quantified_Expression): Expand the
original quantified expression node.
* sem_ch4.adb (Analyze_Quantified_Expression): Properly analyze
the quantified expression and preserve the original non-analyzed
quantified expression when an expansion is needed.
* sem_ch5.adb (Analyze_Iteration_Scheme): Special treatment
for quantified expressions.
(Analyze_Iterator_Specification): Special treatment for quantified
expressions.
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb (revision 185390)
+++ sem_ch5.adb (working copy)
@@ -2087,8 +2087,18 @@
Check_Controlled_Array_Attribute (DS);
- Make_Index (DS, LP, In_Iter_Schm => True);
+ -- The index is not processed during the analysis of a
+ -- quantified expression but delayed to its expansion where the
+ -- quantified expression is transformed into an expression with
+ -- actions.
+ if Nkind (Parent (N)) /= N_Quantified_Expression
+ or else Operating_Mode = Check_Semantics
+ or else Alfa_Mode
+ then
+ Make_Index (DS, LP, In_Iter_Schm => True);
+ end if;
+
Set_Ekind (Id, E_Loop_Parameter);
-- If the loop is part of a predicate or precondition, it may
@@ -2097,14 +2107,7 @@
-- because the second one may be created in a different scope,
-- e.g. a precondition procedure, leading to a crash in GIGI.
- -- Note that if the parent node is a quantified expression,
- -- this preservation is delayed until the expansion of the
- -- quantified expression where the node is rewritten as an
- -- expression with actions.
-
- if (No (Etype (Id)) or else Etype (Id) = Any_Type)
- and then Nkind (Parent (N)) /= N_Quantified_Expression
- then
+ if No (Etype (Id)) or else Etype (Id) = Any_Type then
Set_Etype (Id, Etype (DS));
end if;
@@ -2241,14 +2244,14 @@
-- If domain of iteration is an expression, create a declaration for
-- it, so that finalization actions are introduced outside of the loop.
-- The declaration must be a renaming because the body of the loop may
- -- assign to elements.
+ -- assign to elements. In case of a quantified expression, this
+ -- declaration is delayed to its expansion where the node is rewritten
+ -- as an expression with actions.
- -- Note that if the parent node is a quantified expression, this
- -- declaration is created during the expansion of the quantified
- -- expression where the node is rewritten as an expression with actions.
-
if not Is_Entity_Name (Iter_Name)
- and then Nkind (Parent (Parent (N))) /= N_Quantified_Expression
+ and then (Nkind (Parent (Parent (N))) /= N_Quantified_Expression
+ or else Operating_Mode = Check_Semantics
+ or else Alfa_Mode)
then
declare
Id : constant Entity_Id := Make_Temporary (Loc, 'R', Iter_Name);
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 185390)
+++ exp_ch4.adb (working copy)
@@ -7891,9 +7891,22 @@
Cond : Node_Id;
Decl : Node_Id;
I_Scheme : Node_Id;
+ Original_N : Node_Id;
Test : Node_Id;
begin
+ -- Retrieve the original quantified expression (non analyzed)
+
+ if Present (Loop_Parameter_Specification (N)) then
+ Original_N := Parent (Parent (Loop_Parameter_Specification (N)));
+ else
+ Original_N := Parent (Parent (Iterator_Specification (N)));
+ end if;
+
+ -- Rewrite N with the original quantified expression
+
+ Rewrite (N, Original_N);
+
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Tnn,
@@ -7904,13 +7917,6 @@
Cond := Relocate_Node (Condition (N));
- -- Reset flag analyzed in the condition to force its analysis. Required
- -- since the previous analysis was done with expansion disabled (see
- -- Resolve_Quantified_Expression) and hence checks were not inserted
- -- and record comparisons have not been expanded.
-
- Reset_Analyzed_Flags (Cond);
-
if Is_Universal then
Cond := Make_Op_Not (Loc, Cond);
end if;
@@ -7926,9 +7932,14 @@
Make_Exit_Statement (Loc)));
if Present (Loop_Parameter_Specification (N)) then
- I_Scheme := Relocate_Node (Parent (Loop_Parameter_Specification (N)));
+ I_Scheme :=
+ Make_Iteration_Scheme (Loc,
+ Loop_Parameter_Specification =>
+ Loop_Parameter_Specification (N));
else
- I_Scheme := Relocate_Node (Parent (Iterator_Specification (N)));
+ I_Scheme :=
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification => Iterator_Specification (N));
end if;
Append_To (Actions,
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 185390)
+++ sem_ch4.adb (working copy)
@@ -3390,14 +3390,25 @@
-----------------------------------
procedure Analyze_Quantified_Expression (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Ent : constant Entity_Id :=
- New_Internal_Entity
- (E_Loop, Current_Scope, Sloc (N), 'L');
+ Loc : constant Source_Ptr := Sloc (N);
+ Ent : constant Entity_Id :=
+ New_Internal_Entity
+ (E_Loop, Current_Scope, Sloc (N), 'L');
+ Needs_Expansion : constant Boolean :=
+ Operating_Mode /= Check_Semantics
+ and then not Alfa_Mode;
- Iterator : Node_Id;
+ Iterator : Node_Id;
+ Original_N : Node_Id;
begin
+ -- Preserve the original node used for the expansion of the quantified
+ -- expression.
+
+ if Needs_Expansion then
+ Original_N := Copy_Separate_Tree (N);
+ end if;
+
Set_Etype (Ent, Standard_Void_Type);
Set_Scope (Ent, Current_Scope);
Set_Parent (Ent, N);
@@ -3433,7 +3444,15 @@
Analyze (Condition (N));
End_Scope;
+
Set_Etype (N, Standard_Boolean);
+
+ -- Attach the original node to the iteration scheme created above
+
+ if Needs_Expansion then
+ Set_Etype (Original_N, Standard_Boolean);
+ Set_Parent (Iterator, Original_N);
+ end if;
end Analyze_Quantified_Expression;
-------------------
