[multiple changes]

2010-10-26  Javier Miranda  <miranda@adacore.com>

	* sem_prag.adb (Process_Import_Or_Interface): Skip primitives of
	interface types when processing all the entities in the homonym chain
	that are declared in the same declarative part.

2010-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Process_Range_In_Decl): If the range is part of a
	quantified expression, the insertion point for range checks will be
	arbitrarily far in the tree.
	* sem_ch5.adb (One_Bound): Use Insert_Actions for the declaration of
	the temporary that holds the value of the bounds.
	* sem_res.adb (Resolve_Quantified_Expressions): Disable expansion of
	condition until the full expression is expanded.

From-SVN: r165957

5 files changed, 92 insertions, 37 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 896a17ca..69ae440 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2010-10-26  Javier Miranda  <miranda@adacore.com>
+
+	* sem_prag.adb (Process_Import_Or_Interface): Skip primitives of
+	interface types when processing all the entities in the homonym chain
+	that are declared in the same declarative part.
+
+2010-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Process_Range_In_Decl): If the range is part of a
+	quantified expression, the insertion point for range checks will be
+	arbitrarily far in the tree.
+	* sem_ch5.adb (One_Bound): Use Insert_Actions for the declaration of
+	the temporary that holds the value of the bounds.
+	* sem_res.adb (Resolve_Quantified_Expressions): Disable expansion of
+	condition until the full expression is expanded.
+
 2010-10-26  Robert Dewar  <dewar@adacore.com>
 
 	* opt.ads: Comment fix.
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 3dde575..62aee52 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -17627,10 +17627,10 @@ package body Sem_Ch3 is
       Check_List  : List_Id := Empty_List;
       R_Check_Off : Boolean := False)
    is
-      Lo, Hi    : Node_Id;
-      R_Checks  : Check_Result;
-      Type_Decl : Node_Id;
-      Def_Id    : Entity_Id;
+      Lo, Hi      : Node_Id;
+      R_Checks    : Check_Result;
+      Insert_Node : Node_Id;
+      Def_Id      : Entity_Id;
 
    begin
       Analyze_And_Resolve (R, Base_Type (T));
@@ -17738,32 +17738,43 @@ package body Sem_Ch3 is
             if not R_Check_Off then
                R_Checks := Get_Range_Checks (R, T);
 
-               --  Look up tree to find an appropriate insertion point.
-               --  This seems really junk code, and very brittle, couldn't
-               --  we just use an insert actions call of some kind ???
-
-               Type_Decl := Parent (R);
-               while Present (Type_Decl) and then not
-                 (Nkind_In (Type_Decl, N_Full_Type_Declaration,
-                                       N_Subtype_Declaration,
-                                       N_Loop_Statement,
-                                       N_Task_Type_Declaration)
-                    or else
-                  Nkind_In (Type_Decl, N_Single_Task_Declaration,
-                                       N_Protected_Type_Declaration,
-                                       N_Single_Protected_Declaration))
-               loop
-                  Type_Decl := Parent (Type_Decl);
+               --  Look up tree to find an appropriate insertion point. We
+               --  can't just use insert_actions because later processing
+               --  depends on the insertion node. Prior to Ada2012 the
+               --  insertion point could only be a declaration or a loop, but
+               --  quantified expressions can appear within any context in an
+               --  expression, and the insertion point can be any statement,
+               --  pragma, or declaration.
+
+               Insert_Node := Parent (R);
+               while Present (Insert_Node) loop
+                  exit when
+                    Nkind (Insert_Node) in N_Declaration
+                    and then
+                      not Nkind_In
+                        (Insert_Node, N_Component_Declaration,
+                                      N_Loop_Parameter_Specification,
+                                      N_Function_Specification,
+                                      N_Procedure_Specification);
+
+                  exit when Nkind (Insert_Node) in N_Later_Decl_Item
+                    or else Nkind (Insert_Node) in
+                              N_Statement_Other_Than_Procedure_Call
+                    or else Nkind_In (Insert_Node, N_Procedure_Call_Statement,
+                                                   N_Pragma);
+
+                  Insert_Node := Parent (Insert_Node);
                end loop;
 
                --  Why would Type_Decl not be present???  Without this test,
                --  short regression tests fail.
 
-               if Present (Type_Decl) then
+               if Present (Insert_Node) then
 
-                  --  Case of loop statement (more comments ???)
+                  --  Case of loop statement. Verify that the range is part
+                  --  of the subtype indication of the iteration scheme.
 
-                  if Nkind (Type_Decl) = N_Loop_Statement then
+                  if Nkind (Insert_Node) = N_Loop_Statement then
                      declare
                         Indic : Node_Id;
 
@@ -17780,18 +17791,20 @@ package body Sem_Ch3 is
 
                            Insert_Range_Checks
                              (R_Checks,
-                              Type_Decl,
+                              Insert_Node,
                               Def_Id,
-                              Sloc (Type_Decl),
+                              Sloc (Insert_Node),
                               R,
                               Do_Before => True);
                         end if;
                      end;
 
-                  --  All other cases (more comments ???)
+                  --  Insertion before a declaration. If the declaration
+                  --  includes discriminants, the list of applicable checks
+                  --  is given by the caller.
 
-                  else
-                     Def_Id := Defining_Identifier (Type_Decl);
+                  elsif Nkind (Insert_Node) in N_Declaration then
+                     Def_Id := Defining_Identifier (Insert_Node);
 
                      if (Ekind (Def_Id) = E_Record_Type
                           and then Depends_On_Discriminant (R))
@@ -17800,18 +17813,29 @@ package body Sem_Ch3 is
                           and then Has_Discriminants (Def_Id))
                      then
                         Append_Range_Checks
-                          (R_Checks, Check_List, Def_Id, Sloc (Type_Decl), R);
+                          (R_Checks,
+                            Check_List, Def_Id, Sloc (Insert_Node), R);
 
                      else
                         Insert_Range_Checks
-                          (R_Checks, Type_Decl, Def_Id, Sloc (Type_Decl), R);
+                          (R_Checks,
+                            Insert_Node, Def_Id, Sloc (Insert_Node), R);
 
                      end if;
+
+                  --  Insertion before a statement. Range appears in the
+                  --  context of a quantified expression. Insertion will
+                  --  take place when expression is expanded.
+
+                  else
+                     null;
                   end if;
                end if;
             end if;
          end if;
 
+      --  Case of other than an explicit N_Range node
+
       elsif Expander_Active then
          Get_Index_Bounds (R, Lo, Hi);
          Force_Evaluation (Lo);
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 5edc342..68305d6 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1538,8 +1538,11 @@ package body Sem_Ch5 is
                    Object_Definition   => New_Occurrence_Of (Typ, Loc),
                    Expression          => Relocate_Node (Original_Bound));
 
-               Insert_Before (Parent (N), Decl);
-               Analyze (Decl);
+               --  Insert declaration at proper place. If loop comes from an
+               --  enclosing quantified expression, the insertion point is
+               --  arbitrarily far up in the tree.
+
+               Insert_Action (Parent (N), Decl);
                Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc));
                return Expression (Decl);
             end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 5cf92e1..acc6847 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3928,6 +3928,14 @@ package body Sem_Prag is
                then
                   null;
 
+               --  The pragma does not apply to primitives of interfaces
+
+               elsif Is_Dispatching_Operation (Def_Id)
+                 and then Present (Find_Dispatching_Type (Def_Id))
+                 and then Is_Interface (Find_Dispatching_Type (Def_Id))
+               then
+                  null;
+
                --  Verify that the homonym is in the same declarative part (not
                --  just the same scope).
 
@@ -4047,10 +4055,10 @@ package body Sem_Prag is
            and then C = Convention_CPP
          then
             --  Types treated as CPP classes are treated as limited, but we
-            --  don't require them to be declared this way. A warning is
-            --  issued to encourage the user to declare them as limited.
-            --  This is not an error, for compatibility reasons, because
-            --  these types have been supported this way for some time.
+            --  don't require them to be declared this way. A warning is issued
+            --  to encourage the user to declare them as limited. This is not
+            --  an error, for compatibility reasons, because these types have
+            --  been supported this way for some time.
 
             if not Is_Limited_Type (Def_Id) then
                Error_Msg_N
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index a90c45e..8dd8a52 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7809,9 +7809,13 @@ package body Sem_Res is
    procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
    begin
       --  The loop structure is already resolved during its analysis, only the
-      --  resolution of the condition needs to be done.
+      --  resolution of the condition needs to be done. Expansion is disabled
+      --  so that checks and other generated code are inserted in the tree
+      --  after expression has been rewritten as a loop.
 
+      Expander_Mode_Save_And_Set (False);
       Resolve (Condition (N), Typ);
+      Expander_Mode_Restore;
    end Resolve_Quantified_Expression;
 
    -------------------