[multiple changes]

2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_Allocator_Expression): Ensure that the
	tag assignment and adjustment preceed the accessibility check.
	* exp_ch7.adb (Is_Subprogram_Call): Reimplemented.

2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_prag.adb (Expand_Attributes): Ensure that
	the temporary used to capture the value of attribute 'Old's
	prefix is properly initialized.

2016-04-20  Javier Miranda  <miranda@adacore.com>

	* exp_unst.ads, exp_unst.adb (Get_Level, Subp_Index): Moved to library
	level.

From-SVN: r235258

6 files changed, 102 insertions, 92 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b516cbc..f6f5dc3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_Allocator_Expression): Ensure that the
+	tag assignment and adjustment preceed the accessibility check.
+	* exp_ch7.adb (Is_Subprogram_Call): Reimplemented.
+
+2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_prag.adb (Expand_Attributes): Ensure that
+	the temporary used to capture the value of attribute 'Old's
+	prefix is properly initialized.
+
+2016-04-20  Javier Miranda  <miranda@adacore.com>
+
+	* exp_unst.ads, exp_unst.adb (Get_Level, Subp_Index): Moved to library
+	level.
+
 2016-04-20  Arnaud Charlet  <charlet@adacore.com>
 
 	* sem_ch9.adb (Analyze_Task_Type_Declaration): Shut down warning
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 1906640..7ac8018 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -1182,8 +1182,6 @@ package body Exp_Ch4 is
             end;
          end if;
 
-         Apply_Accessibility_Check (Temp);
-
          --  Generate the tag assignment
 
          --  Suppress the tag assignment for VM targets because VM tags are
@@ -1241,34 +1239,36 @@ package body Exp_Ch4 is
             Insert_Action (N, Tag_Assign);
          end if;
 
-         if Needs_Finalization (DesigT) and then Needs_Finalization (T) then
+         --  Generate an Adjust call if the object will be moved. In Ada 2005,
+         --  the object may be inherently limited, in which case there is no
+         --  Adjust procedure, and the object is built in place. In Ada 95, the
+         --  object can be limited but not inherently limited if this allocator
+         --  came from a return statement (we're allocating the result on the
+         --  secondary stack). In that case, the object will be moved, so we do
+         --  want to Adjust.
 
-            --  Generate an Adjust call if the object will be moved. In Ada
-            --  2005, the object may be inherently limited, in which case
-            --  there is no Adjust procedure, and the object is built in
-            --  place. In Ada 95, the object can be limited but not
-            --  inherently limited if this allocator came from a return
-            --  statement (we're allocating the result on the secondary
-            --  stack). In that case, the object will be moved, so we _do_
-            --  want to Adjust.
+         if Needs_Finalization (DesigT)
+           and then Needs_Finalization (T)
+           and then not Aggr_In_Place
+           and then not Is_Limited_View (T)
+         then
+            --  An unchecked conversion is needed in the classwide case because
+            --  the designated type can be an ancestor of the subtype mark of
+            --  the allocator.
 
-            if not Aggr_In_Place
-              and then not Is_Limited_View (T)
-            then
-               Insert_Action (N,
+            Insert_Action (N,
+              Make_Adjust_Call
+                (Obj_Ref =>
+                   Unchecked_Convert_To (T,
+                     Make_Explicit_Dereference (Loc,
+                       Prefix => New_Occurrence_Of (Temp, Loc))),
+                 Typ     => T));
+         end if;
 
-                 --  An unchecked conversion is needed in the classwide case
-                 --  because the designated type can be an ancestor of the
-                 --  subtype mark of the allocator.
+         --  Note: the accessibility check must be inserted after the call to
+         --  [Deep_]Adjust to ensure proper completion of the assignment.
 
-                 Make_Adjust_Call
-                   (Obj_Ref =>
-                      Unchecked_Convert_To (T,
-                        Make_Explicit_Dereference (Loc,
-                          Prefix => New_Occurrence_Of (Temp, Loc))),
-                    Typ     => T));
-            end if;
-         end if;
+         Apply_Accessibility_Check (Temp);
 
          Rewrite (N, New_Occurrence_Of (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index daa5f91..60ea45b 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -4640,19 +4640,20 @@ package body Exp_Ch7 is
 
          function Is_Subprogram_Call (N : Node_Id) return Traverse_Result is
          begin
-            --  Complex constructs are factored out by the expander and their
-            --  occurrences are replaced with references to temporaries or
-            --  object renamings. Due to this expansion activity, inspect the
-            --  original tree to detect subprogram calls.
-
-            if Nkind_In (N, N_Identifier,
-                            N_Object_Renaming_Declaration)
-              and then Original_Node (N) /= N
-            then
-               Detect_Subprogram_Call (Original_Node (N));
+            --  A regular procedure or function call
+
+            if Nkind (N) in N_Subprogram_Call then
+               Must_Hook := True;
+               return Abandon;
+
+            --  Special cases
 
-               --  The original construct contains a subprogram call, there is
-               --  no point in continuing the tree traversal.
+            --  Heavy expansion may relocate function calls outside the related
+            --  node. Inspect the original node to detect the initial placement
+            --  of the call.
+
+            elsif Original_Node (N) /= N then
+               Detect_Subprogram_Call (Original_Node (N));
 
                if Must_Hook then
                   return Abandon;
@@ -4660,22 +4661,14 @@ package body Exp_Ch7 is
                   return OK;
                end if;
 
-            --  The original construct contains a subprogram call, there is no
-            --  point in continuing the tree traversal.
+            --  Generalized indexing always involves a function call
 
-            elsif Nkind (N) = N_Object_Declaration
-              and then Present (Expression (N))
-              and then Nkind (Original_Node (Expression (N))) = N_Function_Call
+            elsif Nkind (N) = N_Indexed_Component
+              and then Present (Generalized_Indexing (N))
             then
                Must_Hook := True;
                return Abandon;
 
-            --  A regular procedure or function call
-
-            elsif Nkind (N) in N_Subprogram_Call then
-               Must_Hook := True;
-               return Abandon;
-
             --  Keep searching
 
             else
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 62aa80d..5df49ee 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -862,16 +862,16 @@ package body Exp_Prag is
 
                --  Generate a temporary to capture the value of the prefix:
                --    Temp : <Pref type>;
-               --  Place that temporary at the beginning of declarations, to
-               --  prevent anomalies in the GNATprove flow-analysis pass in
-               --  the precondition procedure that follows.
 
                Decl :=
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Temp,
                    Object_Definition   =>
                      New_Occurrence_Of (Etype (Pref), Loc));
-               Set_No_Initialization (Decl);
+
+               --  Place that temporary at the beginning of declarations, to
+               --  prevent anomalies in the GNATprove flow-analysis pass in
+               --  the precondition procedure that follows.
 
                Prepend_To (Decls, Decl);
                Analyze (Decl);
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index c0a3405..668f596 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -138,6 +138,36 @@ package body Exp_Unst is
       Calls.Append (Call);
    end Append_Unique_Call;
 
+   ---------------
+   -- Get_Level --
+   ---------------
+
+   function Get_Level (Subp : Entity_Id; Sub : Entity_Id) return Nat is
+      Lev : Nat;
+      S   : Entity_Id;
+   begin
+      Lev := 1;
+      S   := Sub;
+      loop
+         if S = Subp then
+            return Lev;
+         else
+            S := Enclosing_Subprogram (S);
+            Lev := Lev + 1;
+         end if;
+      end loop;
+   end Get_Level;
+
+   ----------------
+   -- Subp_Index --
+   ----------------
+
+   function Subp_Index (Sub : Entity_Id) return SI_Type is
+   begin
+      pragma Assert (Is_Subprogram (Sub));
+      return SI_Type (UI_To_Int (Subps_Index (Sub)));
+   end Subp_Index;
+
    -----------------------
    -- Unnest_Subprogram --
    -----------------------
@@ -151,17 +181,9 @@ package body Exp_Unst is
       --  This function returns the index of the enclosing subprogram which
       --  will have a Lev value one less than this.
 
-      function Get_Level (Sub : Entity_Id) return Nat;
-      --  Sub is either Subp itself, or a subprogram nested within Subp. This
-      --  function returns the level of nesting (Subp = 1, subprograms that
-      --  are immediately nested within Subp = 2, etc).
-
       function Img_Pos (N : Pos) return String;
       --  Return image of N without leading blank
 
-      function Subp_Index (Sub : Entity_Id) return SI_Type;
-      --  Given the entity for a subprogram, return corresponding Subps index
-
       function Upref_Name
         (Ent   : Entity_Id;
          Index : Pos;
@@ -196,26 +218,6 @@ package body Exp_Unst is
          return Ret;
       end Enclosing_Subp;
 
-      ---------------
-      -- Get_Level --
-      ---------------
-
-      function Get_Level (Sub : Entity_Id) return Nat is
-         Lev : Nat;
-         S   : Entity_Id;
-      begin
-         Lev := 1;
-         S   := Sub;
-         loop
-            if S = Subp then
-               return Lev;
-            else
-               S := Enclosing_Subprogram (S);
-               Lev := Lev + 1;
-            end if;
-         end loop;
-      end Get_Level;
-
       -------------
       -- Img_Pos --
       -------------
@@ -238,16 +240,6 @@ package body Exp_Unst is
       end Img_Pos;
 
       ----------------
-      -- Subp_Index --
-      ----------------
-
-      function Subp_Index (Sub : Entity_Id) return SI_Type is
-      begin
-         pragma Assert (Is_Subprogram (Sub));
-         return SI_Type (UI_To_Int (Subps_Index (Sub)));
-      end Subp_Index;
-
-      ----------------
       -- Upref_Name --
       ----------------
 
@@ -561,7 +553,7 @@ package body Exp_Unst is
                --  Make new entry in subprogram table if not already made
 
                declare
-                  L : constant Nat := Get_Level (Ent);
+                  L : constant Nat := Get_Level (Subp, Ent);
                begin
                   Subps.Append
                     ((Ent           => Ent,
diff --git a/gcc/ada/exp_unst.ads b/gcc/ada/exp_unst.ads
index 084e904..d455175 100644
--- a/gcc/ada/exp_unst.ads
+++ b/gcc/ada/exp_unst.ads
@@ -678,6 +678,14 @@ package Exp_Unst is
    -- Subprograms --
    -----------------
 
+   function Get_Level (Subp : Entity_Id; Sub : Entity_Id) return Nat;
+   --  Sub is either Subp itself, or a subprogram nested within Subp. This
+   --  function returns the level of nesting (Subp = 1, subprograms that
+   --  are immediately nested within Subp = 2, etc).
+
+   function Subp_Index (Sub : Entity_Id) return SI_Type;
+   --  Given the entity for a subprogram, return corresponding Subps index
+
    procedure Unnest_Subprogram (Subp : Entity_Id; Subp_Body : Node_Id);
    --  Subp is a library level subprogram which has nested subprograms, and
    --  Subp_Body is the corresponding N_Subprogram_Body node. This procedure