[multiple changes]

2014-07-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.ads, exp_ch4.adb (Find_Hook_Context): Relocated to Exp_Util.
	* exp_ch7.adb (Process_Declarations): There is no need to check
	that a transient object being hooked is controlled as it would
	not have been hooked in the first place.
	* exp_ch9.adb Remove with and use clause for Exp_Ch4.
	* exp_util.adb (Find_Hook_Context): Relocated from Exp_Ch4.
	(Is_Aliased): A renaming of a transient controlled object is
	not considered aliasing when it occurs within an expression
	with actions.
	(Requires_Cleanup_Actions): There is no need to
	check that a transient object being hooked is controlled as it
	would not have been hooked in the first place.
	* exp_util.ads (Find_Hook_Context): Relocated from Exp_Ch4.

2014-07-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch13.adb (Insert_After_SPARK_Mode): Moved to
	the outer level of routine Analyze_Aspect_Specifications. Ensure
	that the corresponding pragmas of aspects Initial_Condition and
	Initializes are inserted after pragma SPARK_Mode.

2014-07-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Update): Handle
	properly a choice list with more than one choice, where each
	is an aggregate denoting a sequence of array indices for a
	multidimentional array. For SPARK use.

From-SVN: r212646

gcc/ada/ChangeLog

@@ -1,3 +1,33 @@
+2014-07-16  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.ads, exp_ch4.adb (Find_Hook_Context): Relocated to Exp_Util.
+	* exp_ch7.adb (Process_Declarations): There is no need to check
+	that a transient object being hooked is controlled as it would
+	not have been hooked in the first place.
+	* exp_ch9.adb Remove with and use clause for Exp_Ch4.
+	* exp_util.adb (Find_Hook_Context): Relocated from Exp_Ch4.
+	(Is_Aliased): A renaming of a transient controlled object is
+	not considered aliasing when it occurs within an expression
+	with actions.
+	(Requires_Cleanup_Actions): There is no need to
+	check that a transient object being hooked is controlled as it
+	would not have been hooked in the first place.
+	* exp_util.ads (Find_Hook_Context): Relocated from Exp_Ch4.
+
+2014-07-16  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch13.adb (Insert_After_SPARK_Mode): Moved to
+	the outer level of routine Analyze_Aspect_Specifications. Ensure
+	that the corresponding pragmas of aspects Initial_Condition and
+	Initializes are inserted after pragma SPARK_Mode.
+
+2014-07-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute, case 'Update): Handle
+	properly a choice list with more than one choice, where each
+	is an aggregate denoting a sequence of array indices for a
+	multidimentional array. For SPARK use.
+
 2014-07-16  Vadim Godunko  <godunko@adacore.com>
 
 	* a-coinho-shared.adb (Adjust): Create

gcc/ada/exp_ch4.adb

@@ -11390,145 +11390,6 @@ package body Exp_Ch4 is
       Adjust_Result_Type (N, Typ);
    end Expand_Short_Circuit_Operator;
 
-   -----------------------
-   -- Find_Hook_Context --
-   -----------------------
-
-   function Find_Hook_Context (N : Node_Id) return Node_Id is
-      Par : Node_Id;
-      Top : Node_Id;
-
-      Wrapped_Node : Node_Id;
-      --  Note: if we are in a transient scope, we want to reuse it as
-      --  the context for actions insertion, if possible. But if N is itself
-      --  part of the stored actions for the current transient scope,
-      --  then we need to insert at the appropriate (inner) location in
-      --  the not as an action on Node_To_Be_Wrapped.
-
-      In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N);
-
-   begin
-      --  When the node is inside a case/if expression, the lifetime of any
-      --  temporary controlled object is extended. Find a suitable insertion
-      --  node by locating the topmost case or if expressions.
-
-      if In_Cond_Expr then
-         Par := N;
-         Top := N;
-         while Present (Par) loop
-            if Nkind_In (Original_Node (Par), N_Case_Expression,
-                                              N_If_Expression)
-            then
-               Top := Par;
-
-            --  Prevent the search from going too far
-
-            elsif Is_Body_Or_Package_Declaration (Par) then
-               exit;
-            end if;
-
-            Par := Parent (Par);
-         end loop;
-
-         --  The topmost case or if expression is now recovered, but it may
-         --  still not be the correct place to add generated code. Climb to
-         --  find a parent that is part of a declarative or statement list,
-         --  and is not a list of actuals in a call.
-
-         Par := Top;
-         while Present (Par) loop
-            if Is_List_Member (Par)
-              and then not Nkind_In (Par, N_Component_Association,
-                                          N_Discriminant_Association,
-                                          N_Parameter_Association,
-                                          N_Pragma_Argument_Association)
-              and then not Nkind_In
-                             (Parent (Par), N_Function_Call,
-                                            N_Procedure_Call_Statement,
-                                            N_Entry_Call_Statement)
-
-            then
-               return Par;
-
-            --  Prevent the search from going too far
-
-            elsif Is_Body_Or_Package_Declaration (Par) then
-               exit;
-            end if;
-
-            Par := Parent (Par);
-         end loop;
-
-         return Par;
-
-      else
-         Par := N;
-         while Present (Par) loop
-
-            --  Keep climbing past various operators
-
-            if Nkind (Parent (Par)) in N_Op
-              or else Nkind_In (Parent (Par), N_And_Then, N_Or_Else)
-            then
-               Par := Parent (Par);
-            else
-               exit;
-            end if;
-         end loop;
-
-         Top := Par;
-
-         --  The node may be located in a pragma in which case return the
-         --  pragma itself:
-
-         --    pragma Precondition (... and then Ctrl_Func_Call ...);
-
-         --  Similar case occurs when the node is related to an object
-         --  declaration or assignment:
-
-         --    Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
-
-         --  Another case to consider is when the node is part of a return
-         --  statement:
-
-         --    return ... and then Ctrl_Func_Call ...;
-
-         --  Another case is when the node acts as a formal in a procedure
-         --  call statement:
-
-         --    Proc (... and then Ctrl_Func_Call ...);
-
-         if Scope_Is_Transient then
-            Wrapped_Node := Node_To_Be_Wrapped;
-         else
-            Wrapped_Node := Empty;
-         end if;
-
-         while Present (Par) loop
-            if Par = Wrapped_Node
-              or else Nkind_In (Par, N_Assignment_Statement,
-                                     N_Object_Declaration,
-                                     N_Pragma,
-                                     N_Procedure_Call_Statement,
-                                     N_Simple_Return_Statement)
-            then
-               return Par;
-
-            --  Prevent the search from going too far
-
-            elsif Is_Body_Or_Package_Declaration (Par) then
-               exit;
-            end if;
-
-            Par := Parent (Par);
-         end loop;
-
-         --  Return the topmost short circuit operator
-
-         return Top;
-      end if;
-   end Find_Hook_Context;
-
    -------------------------------------
    -- Fixup_Universal_Fixed_Operation --
    -------------------------------------

gcc/ada/exp_ch4.ads

@@ -103,11 +103,4 @@ package Exp_Ch4 is
    --  have special circuitry in Expand_N_Type_Conversion to promote both of
    --  the operands to type Integer.
 
-   function Find_Hook_Context (N : Node_Id) return Node_Id;
-   --  Determine a suitable node on which to attach actions related to N
-   --  that need to be elaborated unconditionally (i.e. in general the topmost
-   --  expression of which N is a subexpression, which may or may not be
-   --  evaluated, for example if N is the right operand of a short circuit
-   --  operator).
-
 end Exp_Ch4;

gcc/ada/exp_ch7.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1825,8 +1825,6 @@ package body Exp_Ch7 is
                  and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
                  and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
                                    N_Object_Declaration
-                 and then Is_Finalizable_Transient
-                            (Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
                then
                   Processing_Actions (Has_No_Init => True);
 

gcc/ada/exp_ch9.adb

@@ -29,7 +29,6 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch3;  use Exp_Ch3;
-with Exp_Ch4;  use Exp_Ch4;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Dbug; use Exp_Dbug;

gcc/ada/exp_util.adb

@@ -2598,6 +2598,145 @@ package body Exp_Util is
       raise Program_Error;
    end Find_Protection_Type;
 
+   -----------------------
+   -- Find_Hook_Context --
+   -----------------------
+
+   function Find_Hook_Context (N : Node_Id) return Node_Id is
+      Par : Node_Id;
+      Top : Node_Id;
+
+      Wrapped_Node : Node_Id;
+      --  Note: if we are in a transient scope, we want to reuse it as
+      --  the context for actions insertion, if possible. But if N is itself
+      --  part of the stored actions for the current transient scope,
+      --  then we need to insert at the appropriate (inner) location in
+      --  the not as an action on Node_To_Be_Wrapped.
+
+      In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N);
+
+   begin
+      --  When the node is inside a case/if expression, the lifetime of any
+      --  temporary controlled object is extended. Find a suitable insertion
+      --  node by locating the topmost case or if expressions.
+
+      if In_Cond_Expr then
+         Par := N;
+         Top := N;
+         while Present (Par) loop
+            if Nkind_In (Original_Node (Par), N_Case_Expression,
+                                              N_If_Expression)
+            then
+               Top := Par;
+
+            --  Prevent the search from going too far
+
+            elsif Is_Body_Or_Package_Declaration (Par) then
+               exit;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         --  The topmost case or if expression is now recovered, but it may
+         --  still not be the correct place to add generated code. Climb to
+         --  find a parent that is part of a declarative or statement list,
+         --  and is not a list of actuals in a call.
+
+         Par := Top;
+         while Present (Par) loop
+            if Is_List_Member (Par)
+              and then not Nkind_In (Par, N_Component_Association,
+                                          N_Discriminant_Association,
+                                          N_Parameter_Association,
+                                          N_Pragma_Argument_Association)
+              and then not Nkind_In
+                             (Parent (Par), N_Function_Call,
+                                            N_Procedure_Call_Statement,
+                                            N_Entry_Call_Statement)
+
+            then
+               return Par;
+
+            --  Prevent the search from going too far
+
+            elsif Is_Body_Or_Package_Declaration (Par) then
+               exit;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         return Par;
+
+      else
+         Par := N;
+         while Present (Par) loop
+
+            --  Keep climbing past various operators
+
+            if Nkind (Parent (Par)) in N_Op
+              or else Nkind_In (Parent (Par), N_And_Then, N_Or_Else)
+            then
+               Par := Parent (Par);
+            else
+               exit;
+            end if;
+         end loop;
+
+         Top := Par;
+
+         --  The node may be located in a pragma in which case return the
+         --  pragma itself:
+
+         --    pragma Precondition (... and then Ctrl_Func_Call ...);
+
+         --  Similar case occurs when the node is related to an object
+         --  declaration or assignment:
+
+         --    Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
+
+         --  Another case to consider is when the node is part of a return
+         --  statement:
+
+         --    return ... and then Ctrl_Func_Call ...;
+
+         --  Another case is when the node acts as a formal in a procedure
+         --  call statement:
+
+         --    Proc (... and then Ctrl_Func_Call ...);
+
+         if Scope_Is_Transient then
+            Wrapped_Node := Node_To_Be_Wrapped;
+         else
+            Wrapped_Node := Empty;
+         end if;
+
+         while Present (Par) loop
+            if Par = Wrapped_Node
+              or else Nkind_In (Par, N_Assignment_Statement,
+                                     N_Object_Declaration,
+                                     N_Pragma,
+                                     N_Procedure_Call_Statement,
+                                     N_Simple_Return_Statement)
+            then
+               return Par;
+
+            --  Prevent the search from going too far
+
+            elsif Is_Body_Or_Package_Declaration (Par) then
+               exit;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         --  Return the topmost short circuit operator
+
+         return Top;
+      end if;
+   end Find_Hook_Context;
+
    ----------------------
    -- Force_Evaluation --
    ----------------------
@@ -4423,7 +4562,18 @@ package body Exp_Util is
             elsif Nkind (Stmt) = N_Object_Renaming_Declaration then
                Ren_Obj := Find_Renamed_Object (Stmt);
 
-               if Present (Ren_Obj) and then Ren_Obj = Trans_Id then
+               if Present (Ren_Obj)
+                 and then Ren_Obj = Trans_Id
+
+                 --  When the related context is an expression with actions,
+                 --  both the transient controlled object and its renaming are
+                 --  bound by the "scope" of the expression with actions. In
+                 --  other words, the two cannot be visible outside the scope,
+                 --  therefore the lifetime of the transient object is not
+                 --  really extended by the renaming.
+
+                 and then Nkind (Rel_Node) /= N_Expression_With_Actions
+               then
                   return True;
                end if;
             end if;
@@ -7193,9 +7343,7 @@ package body Exp_Util is
             elsif Is_Access_Type (Obj_Typ)
               and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
               and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
-                                                      N_Object_Declaration
+                                N_Object_Declaration
-              and then Is_Finalizable_Transient
-                         (Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
             then
                return True;
 

gcc/ada/exp_util.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -445,6 +445,13 @@ package Exp_Util is
    --  Given a protected type or its corresponding record, find the type of
    --  field _object.
 
+   function Find_Hook_Context (N : Node_Id) return Node_Id;
+   --  Determine a suitable node on which to attach actions related to N that
+   --  need to be elaborated unconditionally. In general this is the topmost
+   --  expression of which N is a subexpression, which in turn may or may not
+   --  be evaluated, for example if N is the right operand of a short circuit
+   --  operator.
+
    procedure Force_Evaluation
      (Exp      : Node_Id;
       Name_Req : Boolean := False);

gcc/ada/sem_attr.adb

@@ -6127,6 +6127,7 @@ package body Sem_Attr is
 
       when Attribute_Update => Update : declare
          Comps : Elist_Id := No_Elist;
+         Expr  : Node_Id;
 
          procedure Check_Component_Reference
            (Comp : Entity_Id;
@@ -6310,20 +6311,25 @@ package body Sem_Attr is
                      --  Choice is a sequence of indexes for each dimension
 
                      else
-                        Index_Type := First_Index (P_Type);
+                        Expr := First (Choices (Assoc));
-                        Index := First (Expressions (First (Choices (Assoc))));
+                        while Present (Expr) loop
-                        while Present (Index_Type)
+                           Index_Type := First_Index (P_Type);
-                          and then Present (Index)
+                           Index := First (Expressions (Expr));
-                        loop
+                           while Present (Index_Type)
-                           Analyze_And_Resolve (Index, Etype (Index_Type));
+                             and then Present (Index)
-                           Next_Index (Index_Type);
+                           loop
-                           Next (Index);
+                              Analyze_And_Resolve (Index, Etype (Index_Type));
-                        end loop;
+                              Next_Index (Index_Type);
+                              Next (Index);
+                           end loop;
 
-                        if Present (Index) or else Present (Index_Type) then
+                           if Present (Index) or else Present (Index_Type) then
-                           Error_Msg_N
+                              Error_Msg_N
-                             ("dimension mismatch in index list", Assoc);
+                                ("dimension mismatch in index list", Assoc);
-                        end if;
+                           end if;
+
+                           Next (Expr);
+                        end loop;
                      end if;
                   end;
 

gcc/ada/sem_ch13.adb

@@ -1158,6 +1158,15 @@ package body Sem_Ch13 is
       --  Establish the linkages between an aspect and its corresponding
       --  pragma. Flag Delayed should be set when both constructs are delayed.
 
+      procedure Insert_After_SPARK_Mode
+        (Prag    : Node_Id;
+         Ins_Nod : Node_Id;
+         Decls   : List_Id);
+      --  Subsidiary to the analysis of aspects Abstract_State, Initializes and
+      --  Initial_Condition. Insert node Prag before node Ins_Nod. If Ins_Nod
+      --  denotes pragma SPARK_Mode, then SPARK_Mode is skipped. Decls is the
+      --  associated declarative list where Prag is to reside.
+
       procedure Insert_Delayed_Pragma (Prag : Node_Id);
       --  Insert a postcondition-like pragma into the tree depending on the
       --  context. Prag must denote one of the following: Pre, Post, Depends,
@@ -1182,6 +1191,37 @@ package body Sem_Ch13 is
          Set_Parent                    (Prag, Asp);
       end Decorate_Aspect_And_Pragma;
 
+      -----------------------------
+      -- Insert_After_SPARK_Mode --
+      -----------------------------
+
+      procedure Insert_After_SPARK_Mode
+        (Prag    : Node_Id;
+         Ins_Nod : Node_Id;
+         Decls   : List_Id)
+      is
+         Decl : Node_Id := Ins_Nod;
+
+      begin
+         --  Skip SPARK_Mode
+
+         if Present (Decl)
+           and then Nkind (Decl) = N_Pragma
+           and then Pragma_Name (Decl) = Name_SPARK_Mode
+         then
+            Decl := Next (Decl);
+         end if;
+
+         if Present (Decl) then
+            Insert_Before (Decl, Prag);
+
+         --  Aitem acts as the last declaration
+
+         else
+            Append_To (Decls, Prag);
+         end if;
+      end Insert_After_SPARK_Mode;
+
       ---------------------------
       -- Insert_Delayed_Pragma --
       ---------------------------
@@ -2007,51 +2047,10 @@ package body Sem_Ch13 is
                --  immediately.
 
                when Aspect_Abstract_State => Abstract_State : declare
-                  procedure Insert_After_SPARK_Mode
-                    (Ins_Nod : Node_Id;
-                     Decls   : List_Id);
-                  --  Insert Aitem before node Ins_Nod. If Ins_Nod denotes
-                  --  pragma SPARK_Mode, then SPARK_Mode is skipped. Decls is
-                  --  the associated declarative list where Aitem is to reside.
-
-                  -----------------------------
-                  -- Insert_After_SPARK_Mode --
-                  -----------------------------
-
-                  procedure Insert_After_SPARK_Mode
-                    (Ins_Nod : Node_Id;
-                     Decls   : List_Id)
-                  is
-                     Decl : Node_Id := Ins_Nod;
-
-                  begin
-                     --  Skip SPARK_Mode
-
-                     if Present (Decl)
-                       and then Nkind (Decl) = N_Pragma
-                       and then Pragma_Name (Decl) = Name_SPARK_Mode
-                     then
-                        Decl := Next (Decl);
-                     end if;
-
-                     if Present (Decl) then
-                        Insert_Before (Decl, Aitem);
-
-                     --  Aitem acts as the last declaration
-
-                     else
-                        Append_To (Decls, Aitem);
-                     end if;
-                  end Insert_After_SPARK_Mode;
-
-                  --  Local variables
-
                   Context : Node_Id := N;
                   Decl    : Node_Id;
                   Decls   : List_Id;
 
-               --  Start of processing for Abstract_State
-
                begin
                   --  When aspect Abstract_State appears on a generic package,
                   --  it is propageted to the package instance. The context in
@@ -2080,6 +2079,7 @@ package body Sem_Ch13 is
                      --  inserted after the association renamings.
 
                      if Present (Decls) then
+                        Decl := First (Decls);
 
                         --  The visible declarations of a generic instance have
                         --  the following structure:
@@ -2089,35 +2089,26 @@ package body Sem_Ch13 is
                         --    <first source declaration>
 
                         --  The pragma must be inserted before the first source
-                        --  declaration.
+                        --  declaration, skip the instance "header".
 
                         if Is_Generic_Instance (Defining_Entity (Context)) then
-
-                           --  Skip the instance "header"
-
-                           Decl := First (Decls);
                            while Present (Decl)
                              and then not Comes_From_Source (Decl)
                            loop
                               Decl := Next (Decl);
                            end loop;
-
-                           --  Pragma Abstract_State must be inserted after
-                           --  pragma SPARK_Mode in the tree. This ensures that
-                           --  any error messages dependent on SPARK_Mode will
-                           --  be properly enabled/suppressed.
-
-                           Insert_After_SPARK_Mode (Decl, Decls);
-
-                        --  The related package is not a generic instance, the
-                        --  corresponding pragma must be the first declaration
-                        --  except when SPARK_Mode is already in the list. In
-                        --  that case pragma Abstract_State is placed second.
-
-                        else
-                           Insert_After_SPARK_Mode (First (Decls), Decls);
                         end if;
 
+                        --  Pragma Abstract_State must be inserted after pragma
+                        --  SPARK_Mode in the tree. This ensures that any error
+                        --  messages dependent on SPARK_Mode will be properly
+                        --  enabled/suppressed.
+
+                        Insert_After_SPARK_Mode
+                          (Prag    => Aitem,
+                           Ins_Nod => Decl,
+                           Decls   => Decls);
+
                      --  Otherwise the pragma forms a new declarative list
 
                      else
@@ -2211,7 +2202,15 @@ package body Sem_Ch13 is
                         Set_Visible_Declarations (Context, Decls);
                      end if;
 
-                     Prepend_To (Decls, Aitem);
+                     --  When aspects Abstract_State, Initial_Condition and
+                     --  Initializes are out of order, ensure that pragma
+                     --  SPARK_Mode is always at the top of the declarative
+                     --  list to properly enable/suppress errors.
+
+                     Insert_After_SPARK_Mode
+                       (Prag    => Aitem,
+                        Ins_Nod => First (Decls),
+                        Decls   => Decls);
 
                   else
                      Error_Msg_NE
@@ -2233,9 +2232,9 @@ package body Sem_Ch13 is
                   Decls   : List_Id;
 
                begin
-                  --  When aspect Abstract_State appears on a generic package,
+                  --  When aspect Initializes appears on a generic package,
-                  --  it is propageted to the package instance. The context in
+                  --  it is propageted to the package instance. The context
-                  --  this case is the instance spec.
+                  --  in this case is the instance spec.
 
                   if Nkind (Context) = N_Package_Instantiation then
                      Context := Instance_Spec (Context);
@@ -2260,7 +2259,15 @@ package body Sem_Ch13 is
                         Set_Visible_Declarations (Context, Decls);
                      end if;
 
-                     Prepend_To (Decls, Aitem);
+                     --  When aspects Abstract_State, Initial_Condition and
+                     --  Initializes are out of order, ensure that pragma
+                     --  SPARK_Mode is always at the top of the declarative
+                     --  list to properly enable/suppress errors.
+
+                     Insert_After_SPARK_Mode
+                       (Prag    => Aitem,
+                        Ins_Nod => First (Decls),
+                        Decls   => Decls);
 
                   else
                      Error_Msg_NE