Patchwork [Ada] Cleaning up of quantified expression analysis and expansion.

login
register
mail settings
Submitter Arnaud Charlet
Date March 15, 2012, 8:39 a.m.
Message ID <20120315083936.GA11988@adacore.com>
Download mbox | patch
Permalink /patch/146851/
State New
Headers show

Comments

Arnaud Charlet - March 15, 2012, 8:39 a.m.
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  <pucci@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.

Patch

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