[multiple changes]

2016-06-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* lib.adb: Minor reformatting.
	* sem_util.adb (Is_OK_Volatile_Context): Do
	include Address in the supported attributes.

2016-06-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Case_Expression):
	Code cleanup. Finalize any transient controlled
	objects on exit from a case expression alternative.
	(Expand_N_If_Expression): Code cleanup.
	(Process_Actions): Removed.
	(Process_If_Case_Statements): New routine.
	(Process_Transient_Object): Change the name of formal Rel_Node to
	N and update all occurrences. Update the comment on usage. When
	the type of the context is Boolean, the proper insertion point
	for the finalization call is after the last declaration.

2016-06-14  Ed Schonberg  <schonberg@adacore.com>

	* lib-xref.ads, lib-xref.adb (Has_Deferred_Reference): new
	predicate to determine whether an entity appears in a context
	for which a Deferred_Reference was created, because it is not
	possible to determine when reference is analyzed whether it
	appears in a context in which the entity is modified.
	* sem_ch5.adb (Analyze_Statement): Do not emit a useless warning
	on assignment for an entity that has a deferred_reference.

2016-06-14  Javier Miranda  <miranda@adacore.com>

	* sem_res.adb (Resolve_Actuals): Generate a reference to actuals that
	come from source. Previously the reference was generated only if the
	call comes from source but the call may be rewritten by the expander
	thus causing the notification of spurious warnings.

2016-06-14  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb: Remove further references to AAMP.
	* checks.adb (Apply_Scalar_Range_Check): Take
	Check_Float_Overflow info account.
	* live.ads, live.adb Added subprogram headers and
	start-of-processing-for comments.
	* sem_ch12.adb (Instantiate_Package_Body): Do not suppress
	checks when instantiating runtime units in CodePeer mode.

From-SVN: r237432

13 files changed, 297 insertions, 181 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f975cf7123a..d2d8fa4df46 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,49 @@
+2016-06-14  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* lib.adb: Minor reformatting.
+	* sem_util.adb (Is_OK_Volatile_Context): Do
+	include Address in the supported attributes.
+
+2016-06-14  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Case_Expression):
+	Code cleanup. Finalize any transient controlled
+	objects on exit from a case expression alternative.
+	(Expand_N_If_Expression): Code cleanup.
+	(Process_Actions): Removed.
+	(Process_If_Case_Statements): New routine.
+	(Process_Transient_Object): Change the name of formal Rel_Node to
+	N and update all occurrences. Update the comment on usage. When
+	the type of the context is Boolean, the proper insertion point
+	for the finalization call is after the last declaration.
+
+2016-06-14  Ed Schonberg  <schonberg@adacore.com>
+
+	* lib-xref.ads, lib-xref.adb (Has_Deferred_Reference): new
+	predicate to determine whether an entity appears in a context
+	for which a Deferred_Reference was created, because it is not
+	possible to determine when reference is analyzed whether it
+	appears in a context in which the entity is modified.
+	* sem_ch5.adb (Analyze_Statement): Do not emit a useless warning
+	on assignment for an entity that has a deferred_reference.
+
+2016-06-14  Javier Miranda  <miranda@adacore.com>
+
+	* sem_res.adb (Resolve_Actuals): Generate a reference to actuals that
+	come from source. Previously the reference was generated only if the
+	call comes from source but the call may be rewritten by the expander
+	thus causing the notification of spurious warnings.
+
+2016-06-14  Arnaud Charlet  <charlet@adacore.com>
+
+	* gnat1drv.adb: Remove further references to AAMP.
+	* checks.adb (Apply_Scalar_Range_Check): Take
+	Check_Float_Overflow info account.
+	* live.ads, live.adb Added subprogram headers and
+	start-of-processing-for comments.
+	* sem_ch12.adb (Instantiate_Package_Body): Do not suppress
+	checks when instantiating runtime units in CodePeer mode.
+
 2016-06-14  Arnaud Charlet  <charlet@adacore.com>
 
 	* exp_ch3.adb (Expand_N_Object_Declaration): Only consider
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index ed0a0adb10f..cd8d144f1b8 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3077,15 +3077,11 @@ package body Checks is
       --  Floating-point case
       --  In the floating-point case, we only do range checks if the type is
       --  constrained. We definitely do NOT want range checks for unconstrained
-      --  types, since we want to have infinities
+      --  types, since we want to have infinities, except when
+      --  Check_Float_Overflow is set.
 
       elsif Is_Floating_Point_Type (S_Typ) then
-
-      --  Normally, we only do range checks if the type is constrained. We do
-      --  NOT want range checks for unconstrained types, since we want to have
-      --  infinities.
-
-         if Is_Constrained (S_Typ) then
+         if Is_Constrained (S_Typ) or else Check_Float_Overflow then
             Enable_Range_Check (Expr);
          end if;
 
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e6ea474eec1..a48cdab695d 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -224,15 +224,19 @@ package body Exp_Ch4 is
    --  simple entity, and op is a comparison operator, optimizes it into a
    --  comparison of First and Last.
 
-   procedure Process_Transient_Object
-     (Decl     : Node_Id;
-      Rel_Node : Node_Id);
-   --  Subsidiary routine to the expansion of expression_with_actions and if
-   --  expressions. Generate all the necessary code to finalize a transient
+   procedure Process_If_Case_Statements (N : Node_Id; Stmts : List_Id);
+   --  Inspect and process statement list Stmt of if or case expression N for
+   --  transient controlled objects. If such objects are found, the routine
+   --  generates code to clean them up when the context of the expression is
+   --  evaluated or elaborated.
+
+   procedure Process_Transient_Object (Decl : Node_Id; N : Node_Id);
+   --  Subsidiary routine to the expansion of expression_with_actions, if and
+   --  case expressions. Generate all necessary code to finalize a transient
    --  controlled object when the enclosing context is elaborated or evaluated.
    --  Decl denotes the declaration of the transient controlled object which is
-   --  usually the result of a controlled function call. Rel_Node denotes the
-   --  context, either an expression_with_actions or an if expression.
+   --  usually the result of a controlled function call. N denotes the related
+   --  expression_with_actions, if expression, or case expression.
 
    procedure Rewrite_Comparison (N : Node_Id);
    --  If N is the node for a comparison whose outcome can be determined at
@@ -4658,19 +4662,23 @@ package body Exp_Ch4 is
    ------------------------------
 
    procedure Expand_N_Case_Expression (N : Node_Id) is
-      Loc                  : constant Source_Ptr := Sloc (N);
-      Typ                  : constant Entity_Id  := Etype (N);
-      Acts                 : List_Id;
-      Alt                  : Node_Id;
-      Case_Stmt            : Node_Id;
-      Decl                 : Node_Id;
-      Expr                 : Node_Id;
-      In_Predicate         : Boolean := False;
+      Loc        : constant Source_Ptr := Sloc (N);
+      Par        : constant Node_Id    := Parent (N);
+      Typ        : constant Entity_Id  := Etype (N);
+      Acts       : List_Id;
+      Alt        : Node_Id;
+      Case_Stmt  : Node_Id;
+      Decl       : Node_Id;
+      Expr       : Node_Id;
+      Target     : Entity_Id;
+      Target_Typ : Entity_Id;
+
+      In_Predicate : Boolean := False;
+      --  Flag set when the case expression appears within a predicate
+
       Optimize_Return_Stmt : Boolean := False;
-      Par                  : Node_Id;
-      Ptr_Typ              : Entity_Id;
-      Target               : Entity_Id;
-      Target_Typ           : Entity_Id;
+      --  Flag set when the case expression can be optimized in the context of
+      --  a simple return statement.
 
    begin
       --  Check for MINIMIZED/ELIMINATED overflow mode
@@ -4695,14 +4703,14 @@ package body Exp_Ch4 is
          end if;
       end if;
 
-      --  We expand
+      --  When the type of the case expression is elementary, expand
 
-      --    case X is when A => AX, when B => BX ...
+      --    (case X is when A => AX, when B => BX ...)
 
-      --  to
+      --  into
 
       --    do
-      --       Target : typ;
+      --       Target : Typ;
       --       case X is
       --          when A =>
       --             Target := AX;
@@ -4712,33 +4720,10 @@ package body Exp_Ch4 is
       --       end case;
       --    in Target end;
 
-      --  Except when the case expression appears as part of a simple return
-      --  statement, returning an elementary type, where we expand
-
-      --    return (case X is when A => AX, when B => BX ...)
-
-      --  to
-
-      --    case X is
-      --       when A =>
-      --          return AX;
-      --       when B =>
-      --          return BX;
-      --       ...
-      --    end case;
-
-      --    Note that this expansion is also triggered for expression functions
-      --    containing a single case expression since these functions are
-      --    expanded as above.
-
-      --  However, this expansion is wrong for limited types, and also wrong
-      --  for unconstrained types (since the bounds may not be the same in all
-      --  branches). Furthermore it involves an extra copy for large objects.
-      --  So we take care of this by using the following modified expansion for
-      --  non-elementary types:
+      --  In all other cases expand into
 
       --    do
-      --       type Ptr_Typ is access all typ;
+      --       type Ptr_Typ is access all Typ;
       --       Target : Ptr_Typ;
       --       case X is
       --          when A =>
@@ -4749,6 +4734,20 @@ package body Exp_Ch4 is
       --       end case;
       --    in Target.all end;
 
+      --  This approach avoids extra copies of potentially large objects. It
+      --  also allows handling of values of limited or unconstrained types.
+
+      --  Small optimization: when the case expression appears in the context
+      --  of a simple return statement, expand into
+
+      --    case X is
+      --       when A =>
+      --          return AX;
+      --       when B =>
+      --          return BX;
+      --       ...
+      --    end case;
+
       Case_Stmt :=
         Make_Case_Statement (Loc,
           Expression   => Expression (N),
@@ -4768,43 +4767,50 @@ package body Exp_Ch4 is
          Target_Typ := Typ;
 
          --  ??? Do not perform the optimization when the return statement is
-         --  within a predicate function as this causes supurious errors. A
-         --  possible mismatch in handling this case somewhere else in semantic
-         --  analysis?
+         --  within a predicate function as this causes supurious errors. Could
+         --  this be a possible mismatch in handling this case somewhere else
+         --  in semantic analysis?
 
-         if not In_Predicate
-           and then Nkind (Parent (N)) = N_Simple_Return_Statement
-         then
-            Optimize_Return_Stmt := True;
-         end if;
+         Optimize_Return_Stmt :=
+           Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
+
+      --  Otherwise create an access type to handle the general case using
+      --  'Unrestricted_Access.
+
+      --  Generate:
+      --    type Ptr_Typ is access all Typ;
 
       else
-         Ptr_Typ := Make_Temporary (Loc, 'P');
+         Target_Typ := Make_Temporary (Loc, 'P');
+
          Append_To (Acts,
            Make_Full_Type_Declaration (Loc,
-             Defining_Identifier => Ptr_Typ,
+             Defining_Identifier => Target_Typ,
              Type_Definition     =>
                Make_Access_To_Object_Definition (Loc,
                  All_Present        => True,
                  Subtype_Indication => New_Occurrence_Of (Typ, Loc))));
-         Target_Typ := Ptr_Typ;
       end if;
 
+      --  Create the declaration of the target which captures the value of the
+      --  expression.
+
+      --  Generate:
+      --    Target : [Ptr_]Typ;
+
       if not Optimize_Return_Stmt then
          Target := Make_Temporary (Loc, 'T');
 
-         --  Create declaration for target of expression, and indicate that it
-         --  does not require initialization.
-
          Decl :=
            Make_Object_Declaration (Loc,
              Defining_Identifier => Target,
              Object_Definition   => New_Occurrence_Of (Target_Typ, Loc));
          Set_No_Initialization (Decl);
+
          Append_To (Acts, Decl);
       end if;
 
-      --  Now process the alternatives
+      --  Process the alternatives
 
       Alt := First (Alternatives (N));
       while Present (Alt) loop
@@ -4814,8 +4820,12 @@ package body Exp_Ch4 is
             Stmts    : List_Id;
 
          begin
-            --  As described above, take Unrestricted_Access for case of non-
-            --  scalar types, to avoid big copies, and special cases.
+            --  Take the unrestricted access of the expression value for non-
+            --  scalar types. This approach avoids big copies and covers the
+            --  limited and unconstrained cases.
+
+            --  Generate:
+            --    AX'Unrestricted_Access
 
             if not Is_Elementary_Type (Typ) then
                Alt_Expr :=
@@ -4824,10 +4834,17 @@ package body Exp_Ch4 is
                    Attribute_Name => Name_Unrestricted_Access);
             end if;
 
+            --  Generate:
+            --    return AX['Unrestricted_Access];
+
             if Optimize_Return_Stmt then
                Stmts := New_List (
                  Make_Simple_Return_Statement (Alt_Loc,
                    Expression => Alt_Expr));
+
+            --  Generate:
+            --    Target := AX['Unrestricted_Access];
+
             else
                Stmts := New_List (
                  Make_Assignment_Statement (Alt_Loc,
@@ -4844,6 +4861,16 @@ package body Exp_Ch4 is
                Prepend_List (Actions (Alt), Stmts);
             end if;
 
+            --  Finalize any transient controlled objects on exit from the
+            --  alternative. This is done only in the return optimization case
+            --  because otherwise the case expression is converted into an
+            --  expression with actions which already contains this form of
+            --  processing.
+
+            if Optimize_Return_Stmt then
+               Process_If_Case_Statements (N, Stmts);
+            end if;
+
             Append_To
               (Alternatives (Case_Stmt),
                Make_Case_Statement_Alternative (Sloc (Alt),
@@ -4854,33 +4881,38 @@ package body Exp_Ch4 is
          Next (Alt);
       end loop;
 
-      --  Rewrite parent return statement as a case statement if possible
+      --  Rewrite the parent return statement as a case statement
 
       if Optimize_Return_Stmt then
-         Par := Parent (N);
          Rewrite (Par, Case_Stmt);
          Analyze (Par);
-         return;
-      end if;
-
-      Append_To (Acts, Case_Stmt);
 
-      --  Construct and return final expression with actions
+      --  Otherwise convert the case expression into an expression with actions
 
-      if Is_Elementary_Type (Typ) then
-         Expr := New_Occurrence_Of (Target, Loc);
       else
-         Expr :=
-           Make_Explicit_Dereference (Loc,
-             Prefix => New_Occurrence_Of (Target, Loc));
-      end if;
+         Append_To (Acts, Case_Stmt);
 
-      Rewrite (N,
-        Make_Expression_With_Actions (Loc,
-          Expression => Expr,
-          Actions    => Acts));
+         if Is_Elementary_Type (Typ) then
+            Expr := New_Occurrence_Of (Target, Loc);
 
-      Analyze_And_Resolve (N, Typ);
+         else
+            Expr :=
+              Make_Explicit_Dereference (Loc,
+                Prefix => New_Occurrence_Of (Target, Loc));
+         end if;
+
+         --  Generate:
+         --    do
+         --       ...
+         --    in Target[.all] end;
+
+         Rewrite (N,
+           Make_Expression_With_Actions (Loc,
+             Expression => Expr,
+             Actions    => Acts));
+
+         Analyze_And_Resolve (N, Typ);
+      end if;
    end Expand_N_Case_Expression;
 
    -----------------------------------
@@ -5070,39 +5102,11 @@ package body Exp_Ch4 is
    --  Deal with limited types and condition actions
 
    procedure Expand_N_If_Expression (N : Node_Id) is
-      procedure Process_Actions (Actions : List_Id);
-      --  Inspect and process a single action list of an if expression for
-      --  transient controlled objects. If such objects are found, the routine
-      --  generates code to clean them up when the context of the expression is
-      --  evaluated or elaborated.
-
-      ---------------------
-      -- Process_Actions --
-      ---------------------
-
-      procedure Process_Actions (Actions : List_Id) is
-         Act : Node_Id;
-
-      begin
-         Act := First (Actions);
-         while Present (Act) loop
-            if Nkind (Act) = N_Object_Declaration
-              and then Is_Finalizable_Transient (Act, N)
-            then
-               Process_Transient_Object (Act, N);
-            end if;
-
-            Next (Act);
-         end loop;
-      end Process_Actions;
-
-      --  Local variables
-
-      Loc    : constant Source_Ptr := Sloc (N);
-      Cond   : constant Node_Id    := First (Expressions (N));
-      Thenx  : constant Node_Id    := Next (Cond);
-      Elsex  : constant Node_Id    := Next (Thenx);
-      Typ    : constant Entity_Id  := Etype (N);
+      Cond  : constant Node_Id    := First (Expressions (N));
+      Loc   : constant Source_Ptr := Sloc (N);
+      Thenx : constant Node_Id    := Next (Cond);
+      Elsex : constant Node_Id    := Next (Thenx);
+      Typ   : constant Entity_Id  := Etype (N);
 
       Actions : List_Id;
       Cnn     : Entity_Id;
@@ -5112,8 +5116,6 @@ package body Exp_Ch4 is
       New_N   : Node_Id;
       Ptr_Typ : Entity_Id;
 
-   --  Start of processing for Expand_N_If_Expression
-
    begin
       --  Check for MINIMIZED/ELIMINATED overflow mode
 
@@ -5134,8 +5136,8 @@ package body Exp_Ch4 is
       if Compile_Time_Known_Value (Cond) then
          declare
             function Fold_Known_Value (Cond : Node_Id) return Boolean;
-            --  Fold at compile time. Assumes condition known.
-            --  Return True if folding occurred, meaning we're done.
+            --  Fold at compile time. Assumes condition known. Return True if
+            --  folding occurred, meaning we're done.
 
             ----------------------
             -- Fold_Known_Value --
@@ -5213,8 +5215,8 @@ package body Exp_Ch4 is
          --  of actions. These temporaries need to be finalized after the if
          --  expression is evaluated.
 
-         Process_Actions (Then_Actions (N));
-         Process_Actions (Else_Actions (N));
+         Process_If_Case_Statements (N, Then_Actions (N));
+         Process_If_Case_Statements (N, Else_Actions (N));
 
          --  Generate:
          --    type Ann is access all Typ;
@@ -12894,24 +12896,42 @@ package body Exp_Ch4 is
       return;
    end Optimize_Length_Comparison;
 
+   --------------------------------
+   -- Process_If_Case_Statements --
+   --------------------------------
+
+   procedure Process_If_Case_Statements (N : Node_Id; Stmts : List_Id) is
+      Decl : Node_Id;
+
+   begin
+      Decl := First (Stmts);
+      while Present (Decl) loop
+         if Nkind (Decl) = N_Object_Declaration
+           and then Is_Finalizable_Transient (Decl, N)
+         then
+            Process_Transient_Object (Decl, N);
+         end if;
+
+         Next (Decl);
+      end loop;
+   end Process_If_Case_Statements;
+
    ------------------------------
    -- Process_Transient_Object --
    ------------------------------
 
-   procedure Process_Transient_Object
-     (Decl     : Node_Id;
-      Rel_Node : Node_Id)
-   is
-      Loc         : constant Source_Ptr := Sloc (Decl);
-      Obj_Id      : constant Entity_Id  := Defining_Identifier (Decl);
-      Obj_Typ     : constant Node_Id    := Etype (Obj_Id);
+   procedure Process_Transient_Object (Decl : Node_Id; N : Node_Id) is
+      Loc     : constant Source_Ptr := Sloc (Decl);
+      Obj_Id  : constant Entity_Id  := Defining_Identifier (Decl);
+      Obj_Typ : constant Node_Id    := Etype (Obj_Id);
+
       Desig_Typ   : Entity_Id;
       Expr        : Node_Id;
       Hook_Id     : Entity_Id;
       Hook_Insert : Node_Id;
       Ptr_Id      : Entity_Id;
 
-      Hook_Context : constant Node_Id := Find_Hook_Context (Rel_Node);
+      Hook_Context : constant Node_Id := Find_Hook_Context (N);
       --  The node on which to insert the hook as an action. This is usually
       --  the innermost enclosing non-transient construct.
 
@@ -12920,8 +12940,8 @@ package body Exp_Ch4 is
       --  transient controlled object.
 
    begin
-      if Is_Boolean_Type (Etype (Rel_Node)) then
-         Fin_Context := Last (Actions (Rel_Node));
+      if Is_Boolean_Type (Etype (N)) then
+         Fin_Context := Last (List_Containing (Decl));
       else
          Fin_Context := Hook_Context;
       end if;
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 0e5c670261c..7089c8bc088 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -634,11 +634,9 @@ procedure Gnat1drv is
       if Debug_Flag_Dot_LL then
          Back_End_Handles_Limited_Types := True;
 
-      --  If no debug flag, usage off for AAMP, SCIL cases
+      --  If no debug flag, usage off for SCIL cases
 
-      elsif AAMP_On_Target
-        or else Generate_SCIL
-      then
+      elsif Generate_SCIL then
          Back_End_Handles_Limited_Types := False;
 
       --  Otherwise normal gcc back end, for now still turn flag off by
@@ -667,20 +665,16 @@ procedure Gnat1drv is
          --  back end some day, it would not be true for this test, but it
          --  would be non-GCC, so this is a bit troublesome ???
 
-         Front_End_Inlining := AAMP_On_Target or Generate_C_Code;
+         Front_End_Inlining := Generate_C_Code;
       end if;
 
       --  Set back-end inlining indication
 
       Back_End_Inlining :=
 
-        --  No back-end inlining available on AAMP
-
-        not AAMP_On_Target
-
         --  No back-end inlining available on C generation
 
-        and then not Generate_C_Code
+        not Generate_C_Code
 
         --  No back-end inlining in GNATprove mode, since it just confuses
         --  the formal verification process.
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index c8c0b8556f2..bff6d25b7c8 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1218,6 +1218,21 @@ package body Lib.Xref is
       return E;
    end Get_Key;
 
+   ----------------------------
+   -- Has_Deferred_Reference --
+   ----------------------------
+
+   function Has_Deferred_Reference (Ent : Entity_Id) return Boolean is
+   begin
+      for J in Deferred_References.First .. Deferred_References.Last loop
+         if Deferred_References.Table (J).E = Ent then
+            return True;
+         end if;
+      end loop;
+
+      return False;
+   end Has_Deferred_Reference;
+
    ----------
    -- Hash --
    ----------
diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads
index 3da57bda67c..40950085a6c 100644
--- a/gcc/ada/lib-xref.ads
+++ b/gcc/ada/lib-xref.ads
@@ -613,6 +613,11 @@ package Lib.Xref is
    procedure Process_Deferred_References;
    --  This procedure is called from Frontend to process these table entries
 
+   function Has_Deferred_Reference (Ent : Entity_Id) return Boolean;
+   --  This function determines whether an entity has a pending reference, in
+   --  order to suppress premature warnings about useless assignments. See
+   --  comments in Analyze_Assignment in sem-ch5.adb.
+
    -----------------------------
    -- SPARK Xrefs Information --
    -----------------------------
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index 4b9343245fc..b711c21f592 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -70,10 +70,12 @@ package body Lib is
      (S                : Source_Ptr;
       Unwind_Instances : Boolean;
       Unwind_Subunits  : Boolean) return Unit_Number_Type;
-   --  Common code for Get_Code_Unit (get unit of instantiation for
-   --  location) Get_Source_Unit (get unit of template for location) and
-   --  Get_Top_Level_Code_Unit (same as Get_Code_Unit but not stopping at
-   --  subunits).
+   --  Common processing for routines Get_Code_Unit, Get_Source_Unit, and
+   --  Get_Top_Level_Code_Unit. Unwind_Instances is True when the unit for the
+   --  top-level instantiation should be returned instead of the unit for the
+   --  template, in the case of an instantiation. Unwind_Subunits is True when
+   --  the corresponding top-level unit should be returned instead of a
+   --  subunit, in the case of a subunit.
 
    --------------------------------------------
    -- Access Functions for Unit Table Fields --
@@ -635,8 +637,11 @@ package body Lib is
 
    function Get_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
    begin
-      return Get_Code_Or_Source_Unit (Top_Level_Location (S),
-        Unwind_Instances => False, Unwind_Subunits => False);
+      return
+        Get_Code_Or_Source_Unit
+          (Top_Level_Location (S),
+           Unwind_Instances => False,
+           Unwind_Subunits  => False);
    end Get_Code_Unit;
 
    function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
@@ -652,7 +657,6 @@ package body Lib is
    begin
       if N <= Compilation_Switches.Last then
          return Compilation_Switches.Table (N);
-
       else
          return null;
       end if;
@@ -711,8 +715,9 @@ package body Lib is
 
    function Get_Source_Unit (S : Source_Ptr) return Unit_Number_Type is
    begin
-      return Get_Code_Or_Source_Unit (S,
-        Unwind_Instances => True, Unwind_Subunits => False);
+      return
+        Get_Code_Or_Source_Unit
+          (S, Unwind_Instances => True, Unwind_Subunits => False);
    end Get_Source_Unit;
 
    function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
@@ -726,8 +731,11 @@ package body Lib is
 
    function Get_Top_Level_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
    begin
-      return Get_Code_Or_Source_Unit (Top_Level_Location (S),
-        Unwind_Instances => False, Unwind_Subunits => True);
+      return
+        Get_Code_Or_Source_Unit
+          (Top_Level_Location (S),
+           Unwind_Instances => False,
+           Unwind_Subunits  => True);
    end Get_Top_Level_Code_Unit;
 
    function Get_Top_Level_Code_Unit
diff --git a/gcc/ada/live.adb b/gcc/ada/live.adb
index 5366b513d6c..4a75b9884c6 100644
--- a/gcc/ada/live.adb
+++ b/gcc/ada/live.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2000-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2016, 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- --
@@ -36,10 +36,10 @@ package body Live is
 
    --  Name_Set
 
-   --  The Name_Set type is used to store the temporary mark bits
-   --  used by the garbage collection of entities. Using a separate
-   --  array prevents using up any valuable per-node space and possibly
-   --  results in better locality and cache usage.
+   --  The Name_Set type is used to store the temporary mark bits used by the
+   --  garbage collection of entities. Using a separate array prevents using up
+   --  any valuable per-node space and possibly results in better locality and
+   --  cache usage.
 
    type Name_Set is array (Node_Id range <>) of Boolean;
    pragma Pack (Name_Set);
@@ -66,14 +66,13 @@ package body Live is
    --  The Mark phase is split into two phases:
 
    procedure Init_Marked (Root : Node_Id; Marks : out Name_Set);
-   --  For all subprograms, reset Is_Public flag if a pragma Eliminate
-   --  applies to the entity, and set the Marked flag to Is_Public
+   --  For all subprograms, reset Is_Public flag if a pragma Eliminate applies
+   --  to the entity, and set the Marked flag to Is_Public.
 
    procedure Trace_Marked (Root : Node_Id; Marks : in out Name_Set);
-   --  Traverse the tree skipping any unmarked subprogram bodies.
-   --  All visited entities are marked, as well as entities denoted
-   --  by a visited identifier or operator. When an entity is first
-   --  marked it is traced as well.
+   --  Traverse the tree skipping any unmarked subprogram bodies. All visited
+   --  entities are marked, as well as entities denoted by a visited identifier
+   --  or operator. When an entity is first marked it is traced as well.
 
    --  Local functions
 
@@ -137,6 +136,10 @@ package body Live is
       function Process (N : Node_Id) return Traverse_Result;
       procedure Traverse is new Traverse_Proc (Process);
 
+      -------------
+      -- Process --
+      -------------
+
       function Process (N : Node_Id) return Traverse_Result is
       begin
          case Nkind (N) is
@@ -233,6 +236,10 @@ package body Live is
       function Process (N : Node_Id) return Traverse_Result;
       procedure Traverse is new Traverse_Proc (Process);
 
+      -------------
+      -- Process --
+      -------------
+
       function Process (N : Node_Id) return Traverse_Result is
       begin
          case Nkind (N) is
@@ -263,6 +270,8 @@ package body Live is
          return OK;
       end Process;
 
+   --  Start of processing for Sweep
+
    begin
       Traverse (Root);
    end Sweep;
@@ -277,6 +286,10 @@ package body Live is
       procedure Process (N : Node_Id);
       procedure Traverse is new Traverse_Proc (Process);
 
+      -------------
+      -- Process --
+      -------------
+
       procedure Process (N : Node_Id) is
          Result : Traverse_Result;
          pragma Warnings (Off, Result);
diff --git a/gcc/ada/live.ads b/gcc/ada/live.ads
index 016203d959d..535d0e4c561 100644
--- a/gcc/ada/live.ads
+++ b/gcc/ada/live.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2016, 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- --
@@ -23,14 +23,14 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package implements a compiler phase that determines the set
---  of live entities. For now entities are considered live when they
---  have at least one execution time reference.
+--  This package implements a compiler phase that determines the set of live
+--  entities. For now entities are considered live when they have at least one
+--  execution time reference.
 
 package Live is
 
    procedure Collect_Garbage_Entities;
-   --  Eliminate unreachable entities using a mark-and-sweep from
-   --  the set of root entities, i.e. those having Is_Public set.
+   --  Eliminate unreachable entities using a mark-and-sweep from the set of
+   --  root entities, i.e. those having Is_Public set.
 
 end Live;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 9daba776d11..ac0ba4d86d9 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -11001,8 +11001,12 @@ package body Sem_Ch12 is
             --  Note that we do NOT apply this criterion to children of GNAT
             --  The latter units must suppress checks explicitly if needed.
 
-            if Is_Predefined_File_Name
-                 (Unit_File_Name (Get_Source_Unit (Gen_Decl)))
+            --  We also do not suppress checks in CodePeer mode where we are
+            --  interested in finding possible runtime errors.
+
+            if not CodePeer_Mode
+              and then Is_Predefined_File_Name
+                         (Unit_File_Name (Get_Source_Unit (Gen_Decl)))
             then
                Analyze (Act_Body, Suppress => All_Checks);
             else
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 5a755d0ce86..8e9e2b6d4bf 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -830,10 +830,24 @@ package body Sem_Ch5 is
                --  warnings when an assignment is rewritten as another
                --  assignment, and gets tied up with itself.
 
+               --  There may have been a previous reference to a component of
+               --  the variable, which in general removes the Last_Assignment
+               --  field of the variable to indicate a relevant use of the
+               --  previous assignment. However, if the assignment is to a
+               --  subcomponent the reference may not have registered, because
+               --  it is not possible to determine whether the context is an
+               --  assignment. In those cases we generate a Deferred_Reference,
+               --  to be used at the end of compilation to generate the right
+               --  kind of reference, and we suppress a potential warning for
+               --  a useless assignment, which might be premature. This may
+               --  lose a warning in rare cases, but seems preferable to a
+               --  misleading warning.
+
                if Warn_On_Modified_Unread
                  and then Is_Assignable (Ent)
                  and then Comes_From_Source (N)
                  and then In_Extended_Main_Source_Unit (Ent)
+                 and then not Has_Deferred_Reference (Ent)
                then
                   Warn_On_Useless_Assignment (Ent, N);
                end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e1b22d17b26..aadf594114f 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3704,7 +3704,7 @@ package body Sem_Res is
 
          if Present (A)
            and then Is_Entity_Name (A)
-           and then Comes_From_Source (N)
+           and then Comes_From_Source (A)
          then
             Orig_A := Entity (A);
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f7f41f21ce8..5dbaccd522b 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -13643,7 +13643,8 @@ package body Sem_Util is
 
       elsif Nkind (Context) = N_Attribute_Reference
         and then Prefix (Context) = Obj_Ref
-        and then Nam_In (Attribute_Name (Context), Name_Alignment,
+        and then Nam_In (Attribute_Name (Context), Name_Address,
+                                                   Name_Alignment,
                                                    Name_Component_Size,
                                                    Name_First_Bit,
                                                    Name_Last_Bit,