[multiple changes]

2017-09-07  Ed Schonberg  <schonberg@adacore.com>

	* par-ch6.adb (P_Subprogram): Improve error message on null
	procedure with misplaced aspect specification, which the parser
	first attempts to interpret as a malformed expression function.

2017-09-07  Gary Dismukes  <dismukes@adacore.com>

	* sem_attr.adb (Analyze_Attribute_Old_Result):
	Allow attributes Result and Old in the case of an expression
	function.

2017-09-07  Justin Squirek  <squirek@adacore.com>

	* sem_prag.adb (Process_Atomic_Independent_Shared_Volatile): Propagate
	Volatile to subcomponents.

2017-09-07  Bob Duff  <duff@adacore.com>

	* exp_ch7.adb (Find_Last_Init): Check for the
	case where a build-in-place function call has been replaced by a
	'Reference attribute reference.

2017-09-07  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch7.adb (Has_Referencer): Recurse on Actions of freeze
	nodes.

2017-09-07  Bob Duff  <duff@adacore.com>

	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration,
	Make_Build_In_Place_Call_In_Anonymous_Context): Do not use the
	secondary stack for all functions that return limited tagged
	types -- just do it for dispatching calls.  Misc cleanup.
	* sem_util.ads, sem_util.adb (Unqual_Conv): New function to
	remove qualifications and type conversions. Fix various bugs
	where only a single level of qualification or conversion was
	removed, so e.g. "T1'(T2'(X))" would incorrectly return "T2'(X)"
	instead of "X".
	* checks.adb, exp_util.ads, exp_util.adb, sem_res.adb: Misc related
	cleanup.

2017-09-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (setr_Actual_Subtypes): Within a predicate function
	do not create actual subtypes that may generate further predicate
	functions.
	* sem_ch13.adb (Build_Predicate_Functions): Indicate that entity
	of body is a predicate function as well.
	(Resolve_Aspect_Expressions, Resolve_Name): For a component
	association, only the expression needs resolution, not the name.
	(Resolve_Aspect_Expressions, case Predicates): Construct and
	analyze the predicate function declaration in the scope of the
	type, before making the type and its discriminants visible.

From-SVN: r251835

13 files changed, 492 insertions, 462 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5f7b1bc..7ab4ed4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,58 @@
+2017-09-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch6.adb (P_Subprogram): Improve error message on null
+	procedure with misplaced aspect specification, which the parser
+	first attempts to interpret as a malformed expression function.
+
+2017-09-07  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute_Old_Result):
+	Allow attributes Result and Old in the case of an expression
+	function.
+
+2017-09-07  Justin Squirek  <squirek@adacore.com>
+
+	* sem_prag.adb (Process_Atomic_Independent_Shared_Volatile): Propagate
+	Volatile to subcomponents.
+
+2017-09-07  Bob Duff  <duff@adacore.com>
+
+	* exp_ch7.adb (Find_Last_Init): Check for the
+	case where a build-in-place function call has been replaced by a
+	'Reference attribute reference.
+
+2017-09-07  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch7.adb (Has_Referencer): Recurse on Actions of freeze
+	nodes.
+
+2017-09-07  Bob Duff  <duff@adacore.com>
+
+	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration,
+	Make_Build_In_Place_Call_In_Anonymous_Context): Do not use the
+	secondary stack for all functions that return limited tagged
+	types -- just do it for dispatching calls.  Misc cleanup.
+	* sem_util.ads, sem_util.adb (Unqual_Conv): New function to
+	remove qualifications and type conversions. Fix various bugs
+	where only a single level of qualification or conversion was
+	removed, so e.g. "T1'(T2'(X))" would incorrectly return "T2'(X)"
+	instead of "X".
+	* checks.adb, exp_util.ads, exp_util.adb, sem_res.adb: Misc related
+	cleanup.
+
+2017-09-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (setr_Actual_Subtypes): Within a predicate function
+	do not create actual subtypes that may generate further predicate
+	functions.
+	* sem_ch13.adb (Build_Predicate_Functions): Indicate that entity
+	of body is a predicate function as well.
+	(Resolve_Aspect_Expressions, Resolve_Name): For a component
+	association, only the expression needs resolution, not the name.
+	(Resolve_Aspect_Expressions, case Predicates): Construct and
+	analyze the predicate function declaration in the scope of the
+	type, before making the type and its discriminants visible.
+
 2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/decl.c (warn_on_field_placement): Issue the warning
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index d4f9475..39b11f8 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -136,6 +136,14 @@ package body Exp_Ch6 is
    --  the activation Chain. Note: Master_Actual can be Empty, but only if
    --  there are no tasks.
 
+   function Caller_Known_Size
+     (Func_Call : Node_Id; Result_Subt : Entity_Id) return Boolean;
+   --  True if result subtype is definite, or has a size that does not require
+   --  secondary stack usage (i.e. no variant part or components whose type
+   --  depends on discriminants). In particular, untagged types with only
+   --  access discriminants do not require secondary stack use. Note we must
+   --  always use the secondary stack for dispatching-on-result calls.
+
    procedure Check_Overriding_Operation (Subp : Entity_Id);
    --  Subp is a dispatching operation. Check whether it may override an
    --  inherited private operation, in which case its DT entry is that of
@@ -824,6 +832,18 @@ package body Exp_Ch6 is
       return New_Body;
    end Build_Procedure_Body_Form;
 
+   -----------------------
+   -- Caller_Known_Size --
+   -----------------------
+
+   function Caller_Known_Size
+     (Func_Call : Node_Id; Result_Subt : Entity_Id) return Boolean is
+   begin
+      return (Is_Definite_Subtype (Underlying_Type (Result_Subt))
+              and then No (Controlling_Argument (Func_Call)))
+          or else not Requires_Transient_Scope (Underlying_Type (Result_Subt));
+   end Caller_Known_Size;
+
    --------------------------------
    -- Check_Overriding_Operation --
    --------------------------------
@@ -1631,22 +1651,10 @@ package body Exp_Ch6 is
          Expr    : Node_Id;
          Obj     : Node_Id;
          Obj_Typ : Entity_Id;
-         Var     : Node_Id;
+         Var     : constant Node_Id := Unqual_Conv (Act);
          Var_Id  : Entity_Id;
 
       begin
-         Var := Act;
-
-         --  Use the expression when the context qualifies a reference in some
-         --  fashion.
-
-         while Nkind_In (Var, N_Qualified_Expression,
-                              N_Type_Conversion,
-                              N_Unchecked_Type_Conversion)
-         loop
-            Var := Expression (Var);
-         end loop;
-
          --  Copy the value of the validation variable back into the object
          --  being validated.
 
@@ -6796,12 +6804,7 @@ package body Exp_Ch6 is
                Discrim_Source := Original_Node (Discrim_Source);
             end if;
 
-            while Nkind_In (Discrim_Source, N_Qualified_Expression,
-                                            N_Type_Conversion,
-                                            N_Unchecked_Type_Conversion)
-            loop
-               Discrim_Source := Expression (Discrim_Source);
-            end loop;
+            Discrim_Source := Unqual_Conv (Discrim_Source);
 
             case Nkind (Discrim_Source) is
                when N_Defining_Identifier =>
@@ -7099,7 +7102,7 @@ package body Exp_Ch6 is
    -------------------------------------
 
    function Is_Build_In_Place_Function_Call (N : Node_Id) return Boolean is
-      Exp_Node    : Node_Id := N;
+      Exp_Node    : constant Node_Id := Unqual_Conv (N);
       Function_Id : Entity_Id;
 
    begin
@@ -7119,17 +7122,6 @@ package body Exp_Ch6 is
          return False;
       end if;
 
-      --  Step past qualification, type conversion (which can occur in actual
-      --  parameter contexts), and unchecked conversion (which can occur in
-      --  cases of calls to 'Input).
-
-      if Nkind_In (Exp_Node, N_Qualified_Expression,
-                             N_Type_Conversion,
-                             N_Unchecked_Type_Conversion)
-      then
-         Exp_Node := Expression (N);
-      end if;
-
       if Nkind (Exp_Node) /= N_Function_Call then
          return False;
 
@@ -7771,32 +7763,13 @@ package body Exp_Ch6 is
      (Function_Call : Node_Id)
    is
       Loc             : Source_Ptr;
-      Func_Call       : Node_Id := Function_Call;
+      Func_Call       : constant Node_Id := Unqual_Conv (Function_Call);
       Function_Id     : Entity_Id;
       Result_Subt     : Entity_Id;
       Return_Obj_Id   : Entity_Id;
       Return_Obj_Decl : Entity_Id;
 
-      Definite : Boolean;
-      --  True if result subtype is definite, or has a size that does not
-      --  require secondary stack usage (i.e. no variant part or components
-      --  whose type depends on discriminants). In particular, untagged types
-      --  with only access discriminants do not require secondary stack use.
-      --  Note that if the return type is tagged we must always use the sec.
-      --  stack because the call may dispatch on result.
-
    begin
-      --  Step past qualification, type conversion (which can occur in actual
-      --  parameter contexts), and unchecked conversion (which can occur in
-      --  cases of calls to 'Input).
-
-      if Nkind_In (Func_Call, N_Qualified_Expression,
-                              N_Type_Conversion,
-                              N_Unchecked_Type_Conversion)
-      then
-         Func_Call := Expression (Func_Call);
-      end if;
-
       --  If the call has already been processed to add build-in-place actuals
       --  then return. One place this can occur is for calls to build-in-place
       --  functions that occur within a call to a protected operation, where
@@ -7824,10 +7797,6 @@ package body Exp_Ch6 is
       end if;
 
       Result_Subt := Etype (Function_Id);
-      Definite :=
-        (Is_Definite_Subtype (Underlying_Type (Result_Subt))
-             and then not Is_Tagged_Type (Result_Subt))
-          or else not Requires_Transient_Scope (Underlying_Type (Result_Subt));
 
       --  If the build-in-place function returns a controlled object, then the
       --  object needs to be finalized immediately after the context. Since
@@ -7869,7 +7838,7 @@ package body Exp_Ch6 is
       --  When the result subtype is definite, an object of the subtype is
       --  declared and an access value designating it is passed as an actual.
 
-      elsif Definite then
+      elsif Caller_Known_Size (Func_Call, Result_Subt) then
 
          --  Create a temporary object to hold the function result
 
@@ -7942,7 +7911,7 @@ package body Exp_Ch6 is
       Function_Call : Node_Id)
    is
       Lhs          : constant Node_Id := Name (Assign);
-      Func_Call    : Node_Id := Function_Call;
+      Func_Call    : constant Node_Id := Unqual_Conv (Function_Call);
       Func_Id      : Entity_Id;
       Loc          : Source_Ptr;
       Obj_Decl     : Node_Id;
@@ -7954,15 +7923,6 @@ package body Exp_Ch6 is
       Target       : Node_Id;
 
    begin
-      --  Step past qualification or unchecked conversion (the latter can occur
-      --  in cases of calls to 'Input).
-
-      if Nkind_In (Func_Call, N_Qualified_Expression,
-                              N_Unchecked_Type_Conversion)
-      then
-         Func_Call := Expression (Func_Call);
-      end if;
-
       --  If the call has already been processed to add build-in-place actuals
       --  then return. This should not normally occur in an assignment context,
       --  but we add the protection as a defensive measure.
@@ -8085,7 +8045,7 @@ package body Exp_Ch6 is
       Caller_Object   : Node_Id;
       Def_Id          : Entity_Id;
       Fmaster_Actual  : Node_Id := Empty;
-      Func_Call       : Node_Id := Function_Call;
+      Func_Call       : constant Node_Id := Unqual_Conv (Function_Call);
       Function_Id     : Entity_Id;
       Pool_Actual     : Node_Id;
       Ptr_Typ         : Entity_Id;
@@ -8094,24 +8054,7 @@ package body Exp_Ch6 is
       Res_Decl        : Node_Id;
       Result_Subt     : Entity_Id;
 
-      Definite : Boolean;
-      --  True if result subtype is definite, or has a size that does not
-      --  require secondary stack usage (i.e. no variant part or components
-      --  whose type depends on discriminants). In particular, untagged types
-      --  with only access discriminants do not require secondary stack use.
-      --  Note that if the return type is tagged we must always use the sec.
-      --  stack because the call may dispatch on result.
-
    begin
-      --  Step past qualification or unchecked conversion (the latter can occur
-      --  in cases of calls to 'Input).
-
-      if Nkind_In (Func_Call, N_Qualified_Expression,
-                              N_Unchecked_Type_Conversion)
-      then
-         Func_Call := Expression (Func_Call);
-      end if;
-
       --  If the call has already been processed to add build-in-place actuals
       --  then return. This should not normally occur in an object declaration,
       --  but we add the protection as a defensive measure.
@@ -8135,327 +8078,341 @@ package body Exp_Ch6 is
       end if;
 
       Result_Subt := Etype (Function_Id);
-      Definite :=
-        (Is_Definite_Subtype (Underlying_Type (Result_Subt))
-             and then not Is_Tagged_Type (Result_Subt))
-          or else not Requires_Transient_Scope (Underlying_Type (Result_Subt));
 
-      --  Create an access type designating the function's result subtype. We
-      --  use the type of the original call because it may be a call to an
-      --  inherited operation, which the expansion has replaced with the parent
-      --  operation that yields the parent type. Note that this access type
-      --  must be declared before we establish a transient scope, so that it
-      --  receives the proper accessibility level.
+      declare
+         Definite : constant Boolean :=
+           Caller_Known_Size (Func_Call, Result_Subt);
+      begin
+         --  Create an access type designating the function's result subtype.
+         --  We use the type of the original call because it may be a call to
+         --  an inherited operation, which the expansion has replaced with the
+         --  parent operation that yields the parent type. Note that this
+         --  access type must be declared before we establish a transient
+         --  scope, so that it receives the proper accessibility level.
+
+         Ptr_Typ := Make_Temporary (Loc, 'A');
+         Ptr_Typ_Decl :=
+           Make_Full_Type_Declaration (Loc,
+             Defining_Identifier => Ptr_Typ,
+             Type_Definition     =>
+               Make_Access_To_Object_Definition (Loc,
+                 All_Present        => True,
+                 Subtype_Indication =>
+                   New_Occurrence_Of (Etype (Function_Call), Loc)));
+
+         --  The access type and its accompanying object must be inserted after
+         --  the object declaration in the constrained case, so that the
+         --  function call can be passed access to the object. In the
+         --  indefinite case, or if the object declaration is for a return
+         --  object, the access type and object must be inserted before the
+         --  object, since the object declaration is rewritten to be a renaming
+         --  of a dereference of the access object. Note: we need to freeze
+         --  Ptr_Typ explicitly, because the result object is in a different
+         --  (transient) scope, so won't cause freezing.
+
+         if Definite
+           and then not Is_Return_Object (Defining_Identifier (Obj_Decl))
+         then
+            Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl);
+         else
+            Insert_Action (Obj_Decl, Ptr_Typ_Decl);
+         end if;
 
-      Ptr_Typ := Make_Temporary (Loc, 'A');
-      Ptr_Typ_Decl :=
-        Make_Full_Type_Declaration (Loc,
-          Defining_Identifier => Ptr_Typ,
-          Type_Definition     =>
-            Make_Access_To_Object_Definition (Loc,
-              All_Present        => True,
-              Subtype_Indication =>
-                New_Occurrence_Of (Etype (Function_Call), Loc)));
-
-      --  The access type and its accompanying object must be inserted after
-      --  the object declaration in the constrained case, so that the function
-      --  call can be passed access to the object. In the indefinite case,
-      --  or if the object declaration is for a return object, the access type
-      --  and object must be inserted before the object, since the object
-      --  declaration is rewritten to be a renaming of a dereference of the
-      --  access object. Note: we need to freeze Ptr_Typ explicitly, because
-      --  the result object is in a different (transient) scope, so won't
-      --  cause freezing.
-
-      if Definite
-        and then not Is_Return_Object (Defining_Identifier (Obj_Decl))
-      then
-         Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl);
-      else
-         Insert_Action (Obj_Decl, Ptr_Typ_Decl);
-      end if;
+         --  Force immediate freezing of Ptr_Typ because Res_Decl will be
+         --  elaborated in an inner (transient) scope and thus won't cause
+         --  freezing by itself.
 
-      --  Force immediate freezing of Ptr_Typ because Res_Decl will be
-      --  elaborated in an inner (transient) scope and thus won't cause
-      --  freezing by itself.
+         declare
+            Ptr_Typ_Freeze_Ref : constant Node_Id :=
+                                   New_Occurrence_Of (Ptr_Typ, Loc);
+         begin
+            Set_Parent (Ptr_Typ_Freeze_Ref, Ptr_Typ_Decl);
+            Freeze_Expression (Ptr_Typ_Freeze_Ref);
+         end;
 
-      declare
-         Ptr_Typ_Freeze_Ref : constant Node_Id :=
-                                New_Occurrence_Of (Ptr_Typ, Loc);
-      begin
-         Set_Parent (Ptr_Typ_Freeze_Ref, Ptr_Typ_Decl);
-         Freeze_Expression (Ptr_Typ_Freeze_Ref);
-      end;
+         --  If the object is a return object of an enclosing build-in-place
+         --  function, then the implicit build-in-place parameters of the
+         --  enclosing function are simply passed along to the called function.
+         --  (Unfortunately, this won't cover the case of extension aggregates
+         --  where the ancestor part is a build-in-place indefinite function
+         --  call that should be passed along the caller's parameters.
+         --  Currently those get mishandled by reassigning the result of the
+         --  call to the aggregate return object, when the call result should
+         --  really be directly built in place in the aggregate and not in a
+         --  temporary. ???)
+
+         if Is_Return_Object (Defining_Identifier (Obj_Decl)) then
+            Pass_Caller_Acc := True;
+
+            --  When the enclosing function has a BIP_Alloc_Form formal then we
+            --  pass it along to the callee (such as when the enclosing
+            --  function has an unconstrained or tagged result type).
+
+            if Needs_BIP_Alloc_Form (Encl_Func) then
+               if RTE_Available (RE_Root_Storage_Pool_Ptr) then
+                  Pool_Actual :=
+                    New_Occurrence_Of
+                      (Build_In_Place_Formal
+                        (Encl_Func, BIP_Storage_Pool), Loc);
+
+               --  The build-in-place pool formal is not built on e.g. ZFP
 
-      --  If the object is a return object of an enclosing build-in-place
-      --  function, then the implicit build-in-place parameters of the
-      --  enclosing function are simply passed along to the called function.
-      --  (Unfortunately, this won't cover the case of extension aggregates
-      --  where the ancestor part is a build-in-place indefinite function
-      --  call that should be passed along the caller's parameters. Currently
-      --  those get mishandled by reassigning the result of the call to the
-      --  aggregate return object, when the call result should really be
-      --  directly built in place in the aggregate and not in a temporary. ???)
-
-      if Is_Return_Object (Defining_Identifier (Obj_Decl)) then
-         Pass_Caller_Acc := True;
-
-         --  When the enclosing function has a BIP_Alloc_Form formal then we
-         --  pass it along to the callee (such as when the enclosing function
-         --  has an unconstrained or tagged result type).
-
-         if Needs_BIP_Alloc_Form (Encl_Func) then
-            if RTE_Available (RE_Root_Storage_Pool_Ptr) then
-               Pool_Actual :=
-                 New_Occurrence_Of
-                   (Build_In_Place_Formal (Encl_Func, BIP_Storage_Pool), Loc);
+               else
+                  Pool_Actual := Empty;
+               end if;
+
+               Add_Unconstrained_Actuals_To_Build_In_Place_Call
+                 (Function_Call  => Func_Call,
+                  Function_Id    => Function_Id,
+                  Alloc_Form_Exp =>
+                    New_Occurrence_Of
+                      (Build_In_Place_Formal (Encl_Func, BIP_Alloc_Form), Loc),
+                  Pool_Actual    => Pool_Actual);
 
-            --  The build-in-place pool formal is not built on e.g. ZFP
+            --  Otherwise, if enclosing function has a definite result subtype,
+            --  then caller allocation will be used.
 
             else
-               Pool_Actual := Empty;
+               Add_Unconstrained_Actuals_To_Build_In_Place_Call
+                 (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
             end if;
 
-            Add_Unconstrained_Actuals_To_Build_In_Place_Call
-              (Function_Call  => Func_Call,
-               Function_Id    => Function_Id,
-               Alloc_Form_Exp =>
+            if Needs_BIP_Finalization_Master (Encl_Func) then
+               Fmaster_Actual :=
                  New_Occurrence_Of
-                   (Build_In_Place_Formal (Encl_Func, BIP_Alloc_Form), Loc),
-               Pool_Actual    => Pool_Actual);
+                   (Build_In_Place_Formal
+                      (Encl_Func, BIP_Finalization_Master), Loc);
+            end if;
 
-         --  Otherwise, if enclosing function has a definite result subtype,
-         --  then caller allocation will be used.
+            --  Retrieve the BIPacc formal from the enclosing function and
+            --  convert it to the access type of the callee's BIP_Object_Access
+            --  formal.
+
+            Caller_Object :=
+              Make_Unchecked_Type_Conversion (Loc,
+                Subtype_Mark =>
+                  New_Occurrence_Of
+                    (Etype
+                       (Build_In_Place_Formal
+                         (Function_Id, BIP_Object_Access)),
+                     Loc),
+                Expression   =>
+                  New_Occurrence_Of
+                    (Build_In_Place_Formal (Encl_Func, BIP_Object_Access),
+                     Loc));
+
+         --  In the definite case, add an implicit actual to the function call
+         --  that provides access to the declared object. An unchecked
+         --  conversion to the (specific) result type of the function is
+         --  inserted to handle the case where the object is declared with a
+         --  class-wide type.
+
+         elsif Definite then
+            Caller_Object :=
+               Make_Unchecked_Type_Conversion (Loc,
+                 Subtype_Mark => New_Occurrence_Of (Result_Subt, Loc),
+                 Expression   => New_Occurrence_Of (Obj_Def_Id, Loc));
+
+            --  When the function has a controlling result, an allocation-form
+            --  parameter must be passed indicating that the caller is
+            --  allocating the result object. This is needed because such a
+            --  function can be called as a dispatching operation and must be
+            --  treated similarly to functions with indefinite result subtypes.
 
-         else
             Add_Unconstrained_Actuals_To_Build_In_Place_Call
               (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
-         end if;
-
-         if Needs_BIP_Finalization_Master (Encl_Func) then
-            Fmaster_Actual :=
-              New_Occurrence_Of
-                (Build_In_Place_Formal
-                   (Encl_Func, BIP_Finalization_Master), Loc);
-         end if;
-
-         --  Retrieve the BIPacc formal from the enclosing function and convert
-         --  it to the access type of the callee's BIP_Object_Access formal.
-
-         Caller_Object :=
-           Make_Unchecked_Type_Conversion (Loc,
-             Subtype_Mark =>
-               New_Occurrence_Of
-                 (Etype
-                    (Build_In_Place_Formal (Function_Id, BIP_Object_Access)),
-                  Loc),
-             Expression   =>
-               New_Occurrence_Of
-                 (Build_In_Place_Formal (Encl_Func, BIP_Object_Access),
-                  Loc));
-
-      --  In the definite case, add an implicit actual to the function call
-      --  that provides access to the declared object. An unchecked conversion
-      --  to the (specific) result type of the function is inserted to handle
-      --  the case where the object is declared with a class-wide type.
 
-      elsif Definite then
-         Caller_Object :=
-            Make_Unchecked_Type_Conversion (Loc,
-              Subtype_Mark => New_Occurrence_Of (Result_Subt, Loc),
-              Expression   => New_Occurrence_Of (Obj_Def_Id, Loc));
+         --  The allocation for indefinite library-level objects occurs on the
+         --  heap as opposed to the secondary stack. This accommodates DLLs
+         --  where the secondary stack is destroyed after each library
+         --  unload. This is a hybrid mechanism where a stack-allocated object
+         --  lives on the heap.
 
-         --  When the function has a controlling result, an allocation-form
-         --  parameter must be passed indicating that the caller is allocating
-         --  the result object. This is needed because such a function can be
-         --  called as a dispatching operation and must be treated similarly
-         --  to functions with indefinite result subtypes.
+         elsif Is_Library_Level_Entity (Defining_Identifier (Obj_Decl))
+           and then not Restriction_Active (No_Implicit_Heap_Allocations)
+         then
+            Add_Unconstrained_Actuals_To_Build_In_Place_Call
+              (Func_Call, Function_Id, Alloc_Form => Global_Heap);
+            Caller_Object := Empty;
 
-         Add_Unconstrained_Actuals_To_Build_In_Place_Call
-           (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
+            --  Create a finalization master for the access result type to
+            --  ensure that the heap allocation can properly chain the object
+            --  and later finalize it when the library unit goes out of scope.
 
-      --  The allocation for indefinite library-level objects occurs on the
-      --  heap as opposed to the secondary stack. This accommodates DLLs where
-      --  the secondary stack is destroyed after each library unload. This is
-      --  a hybrid mechanism where a stack-allocated object lives on the heap.
+            if Needs_Finalization (Etype (Func_Call)) then
+               Build_Finalization_Master
+                 (Typ            => Ptr_Typ,
+                  For_Lib_Level  => True,
+                  Insertion_Node => Ptr_Typ_Decl);
 
-      elsif Is_Library_Level_Entity (Defining_Identifier (Obj_Decl))
-        and then not Restriction_Active (No_Implicit_Heap_Allocations)
-      then
-         Add_Unconstrained_Actuals_To_Build_In_Place_Call
-           (Func_Call, Function_Id, Alloc_Form => Global_Heap);
-         Caller_Object := Empty;
+               Fmaster_Actual :=
+                 Make_Attribute_Reference (Loc,
+                   Prefix         =>
+                     New_Occurrence_Of (Finalization_Master (Ptr_Typ), Loc),
+                   Attribute_Name => Name_Unrestricted_Access);
+            end if;
 
-         --  Create a finalization master for the access result type to ensure
-         --  that the heap allocation can properly chain the object and later
-         --  finalize it when the library unit goes out of scope.
+         --  In other indefinite cases, pass an indication to do the allocation
+         --  on the secondary stack and set Caller_Object to Empty so that a
+         --  null value will be passed for the caller's object address. A
+         --  transient scope is established to ensure eventual cleanup of the
+         --  result.
 
-         if Needs_Finalization (Etype (Func_Call)) then
-            Build_Finalization_Master
-              (Typ            => Ptr_Typ,
-               For_Lib_Level  => True,
-               Insertion_Node => Ptr_Typ_Decl);
+         else
+            Add_Unconstrained_Actuals_To_Build_In_Place_Call
+              (Func_Call, Function_Id, Alloc_Form => Secondary_Stack);
+            Caller_Object := Empty;
 
-            Fmaster_Actual :=
-              Make_Attribute_Reference (Loc,
-                Prefix         =>
-                  New_Occurrence_Of (Finalization_Master (Ptr_Typ), Loc),
-                Attribute_Name => Name_Unrestricted_Access);
+            Establish_Transient_Scope (Obj_Decl, Sec_Stack => True);
          end if;
 
-      --  In other indefinite cases, pass an indication to do the allocation
-      --  on the secondary stack and set Caller_Object to Empty so that a null
-      --  value will be passed for the caller's object address. A transient
-      --  scope is established to ensure eventual cleanup of the result.
-
-      else
-         Add_Unconstrained_Actuals_To_Build_In_Place_Call
-           (Func_Call, Function_Id, Alloc_Form => Secondary_Stack);
-         Caller_Object := Empty;
+         --  Pass along any finalization master actual, which is needed in the
+         --  case where the called function initializes a return object of an
+         --  enclosing build-in-place function.
 
-         Establish_Transient_Scope (Obj_Decl, Sec_Stack => True);
-      end if;
-
-      --  Pass along any finalization master actual, which is needed in the
-      --  case where the called function initializes a return object of an
-      --  enclosing build-in-place function.
-
-      Add_Finalization_Master_Actual_To_Build_In_Place_Call
-        (Func_Call  => Func_Call,
-         Func_Id    => Function_Id,
-         Master_Exp => Fmaster_Actual);
+         Add_Finalization_Master_Actual_To_Build_In_Place_Call
+           (Func_Call  => Func_Call,
+            Func_Id    => Function_Id,
+            Master_Exp => Fmaster_Actual);
 
-      if Nkind (Parent (Obj_Decl)) = N_Extended_Return_Statement
-        and then Has_Task (Result_Subt)
-      then
-         --  Here we're passing along the master that was passed in to this
-         --  function.
+         if Nkind (Parent (Obj_Decl)) = N_Extended_Return_Statement
+           and then Has_Task (Result_Subt)
+         then
+            --  Here we're passing along the master that was passed in to this
+            --  function.
 
-         Add_Task_Actuals_To_Build_In_Place_Call
-           (Func_Call, Function_Id,
-            Master_Actual =>
-              New_Occurrence_Of
-                (Build_In_Place_Formal (Encl_Func, BIP_Task_Master), Loc));
+            Add_Task_Actuals_To_Build_In_Place_Call
+              (Func_Call, Function_Id,
+               Master_Actual =>
+                 New_Occurrence_Of
+                   (Build_In_Place_Formal (Encl_Func, BIP_Task_Master), Loc));
 
-      else
-         Add_Task_Actuals_To_Build_In_Place_Call
-           (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster));
-      end if;
+         else
+            Add_Task_Actuals_To_Build_In_Place_Call
+              (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster));
+         end if;
 
-      Add_Access_Actual_To_Build_In_Place_Call
-        (Func_Call, Function_Id, Caller_Object, Is_Access => Pass_Caller_Acc);
+         Add_Access_Actual_To_Build_In_Place_Call
+           (Func_Call,
+            Function_Id,
+            Caller_Object,
+            Is_Access => Pass_Caller_Acc);
 
-      --  Finally, create an access object initialized to a reference to the
-      --  function call. We know this access value cannot be null, so mark the
-      --  entity accordingly to suppress the access check.
+         --  Finally, create an access object initialized to a reference to the
+         --  function call. We know this access value cannot be null, so mark
+         --  the entity accordingly to suppress the access check.
 
-      Def_Id := Make_Temporary (Loc, 'R', Func_Call);
-      Set_Etype (Def_Id, Ptr_Typ);
-      Set_Is_Known_Non_Null (Def_Id);
+         Def_Id := Make_Temporary (Loc, 'R', Func_Call);
+         Set_Etype (Def_Id, Ptr_Typ);
+         Set_Is_Known_Non_Null (Def_Id);
 
-      Res_Decl :=
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => Def_Id,
-          Constant_Present    => True,
-          Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc),
-          Expression          =>
-            Make_Reference (Loc, Relocate_Node (Func_Call)));
+         Res_Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Def_Id,
+             Constant_Present    => True,
+             Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc),
+             Expression          =>
+               Make_Reference (Loc, Relocate_Node (Func_Call)));
 
-      Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl);
+         Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl);
 
-      --  If the result subtype of the called function is definite and is not
-      --  itself the return expression of an enclosing BIP function, then mark
-      --  the object as having no initialization.
+         --  If the result subtype of the called function is definite and is
+         --  not itself the return expression of an enclosing BIP function,
+         --  then mark the object as having no initialization.
 
-      if Definite
-        and then not Is_Return_Object (Defining_Identifier (Obj_Decl))
-      then
-         --  The related object declaration is encased in a transient block
-         --  because the build-in-place function call contains at least one
-         --  nested function call that produces a controlled transient
-         --  temporary:
+         if Definite
+           and then not Is_Return_Object (Defining_Identifier (Obj_Decl))
+         then
+            --  The related object declaration is encased in a transient block
+            --  because the build-in-place function call contains at least one
+            --  nested function call that produces a controlled transient
+            --  temporary:
 
-         --    Obj : ... := BIP_Func_Call (Ctrl_Func_Call);
+            --    Obj : ... := BIP_Func_Call (Ctrl_Func_Call);
 
-         --  Since the build-in-place expansion decouples the call from the
-         --  object declaration, the finalization machinery lacks the context
-         --  which prompted the generation of the transient block. To resolve
-         --  this scenario, store the build-in-place call.
+            --  Since the build-in-place expansion decouples the call from the
+            --  object declaration, the finalization machinery lacks the
+            --  context which prompted the generation of the transient
+            --  block. To resolve this scenario, store the build-in-place call.
 
-         if Scope_Is_Transient and then Node_To_Be_Wrapped = Obj_Decl then
-            Set_BIP_Initialization_Call (Obj_Def_Id, Res_Decl);
-         end if;
+            if Scope_Is_Transient and then Node_To_Be_Wrapped = Obj_Decl then
+               Set_BIP_Initialization_Call (Obj_Def_Id, Res_Decl);
+            end if;
 
-         Set_Expression (Obj_Decl, Empty);
-         Set_No_Initialization (Obj_Decl);
+            Set_Expression (Obj_Decl, Empty);
+            Set_No_Initialization (Obj_Decl);
 
-      --  In case of an indefinite result subtype, or if the call is the
-      --  return expression of an enclosing BIP function, rewrite the object
-      --  declaration as an object renaming where the renamed object is a
-      --  dereference of <function_Call>'reference:
-      --
-      --      Obj : Subt renames <function_call>'Ref.all;
+         --  In case of an indefinite result subtype, or if the call is the
+         --  return expression of an enclosing BIP function, rewrite the object
+         --  declaration as an object renaming where the renamed object is a
+         --  dereference of <function_Call>'reference:
+         --
+         --      Obj : Subt renames <function_call>'Ref.all;
 
-      else
-         Call_Deref :=
-           Make_Explicit_Dereference (Obj_Loc,
-             Prefix => New_Occurrence_Of (Def_Id, Obj_Loc));
-
-         Rewrite (Obj_Decl,
-           Make_Object_Renaming_Declaration (Obj_Loc,
-             Defining_Identifier => Make_Temporary (Obj_Loc, 'D'),
-             Subtype_Mark        => New_Occurrence_Of (Result_Subt, Obj_Loc),
-             Name                => Call_Deref));
-
-         Set_Renamed_Object (Defining_Identifier (Obj_Decl), Call_Deref);
-
-         --  If the original entity comes from source, then mark the new
-         --  entity as needing debug information, even though it's defined
-         --  by a generated renaming that does not come from source, so that
-         --  the Materialize_Entity flag will be set on the entity when
-         --  Debug_Renaming_Declaration is called during analysis.
-
-         if Comes_From_Source (Obj_Def_Id) then
-            Set_Debug_Info_Needed (Defining_Identifier (Obj_Decl));
-         end if;
+         else
+            Call_Deref :=
+              Make_Explicit_Dereference (Obj_Loc,
+                Prefix => New_Occurrence_Of (Def_Id, Obj_Loc));
+
+            Rewrite (Obj_Decl,
+              Make_Object_Renaming_Declaration (Obj_Loc,
+                Defining_Identifier => Make_Temporary (Obj_Loc, 'D'),
+                Subtype_Mark => New_Occurrence_Of (Result_Subt, Obj_Loc),
+                Name => Call_Deref));
+
+            Set_Renamed_Object (Defining_Identifier (Obj_Decl), Call_Deref);
+
+            --  If the original entity comes from source, then mark the new
+            --  entity as needing debug information, even though it's defined
+            --  by a generated renaming that does not come from source, so that
+            --  the Materialize_Entity flag will be set on the entity when
+            --  Debug_Renaming_Declaration is called during analysis.
+
+            if Comes_From_Source (Obj_Def_Id) then
+               Set_Debug_Info_Needed (Defining_Identifier (Obj_Decl));
+            end if;
 
-         Analyze (Obj_Decl);
+            Analyze (Obj_Decl);
 
-         --  Replace the internal identifier of the renaming declaration's
-         --  entity with identifier of the original object entity. We also have
-         --  to exchange the entities containing their defining identifiers to
-         --  ensure the correct replacement of the object declaration by the
-         --  object renaming declaration to avoid homograph conflicts (since
-         --  the object declaration's defining identifier was already entered
-         --  in current scope). The Next_Entity links of the two entities also
-         --  have to be swapped since the entities are part of the return
-         --  scope's entity list and the list structure would otherwise be
-         --  corrupted. Finally, the homonym chain must be preserved as well.
+            --  Replace the internal identifier of the renaming declaration's
+            --  entity with identifier of the original object entity. We also
+            --  have to exchange the entities containing their defining
+            --  identifiers to ensure the correct replacement of the object
+            --  declaration by the object renaming declaration to avoid
+            --  homograph conflicts (since the object declaration's defining
+            --  identifier was already entered in current scope). The
+            --  Next_Entity links of the two entities also have to be swapped
+            --  since the entities are part of the return scope's entity list
+            --  and the list structure would otherwise be corrupted. Finally,
+            --  the homonym chain must be preserved as well.
 
-         declare
-            Ren_Id  : constant Entity_Id := Defining_Entity (Obj_Decl);
-            Next_Id : constant Entity_Id := Next_Entity (Ren_Id);
+            declare
+               Ren_Id  : constant Entity_Id := Defining_Entity (Obj_Decl);
+               Next_Id : constant Entity_Id := Next_Entity (Ren_Id);
 
-         begin
-            Set_Chars (Ren_Id, Chars (Obj_Def_Id));
+            begin
+               Set_Chars (Ren_Id, Chars (Obj_Def_Id));
 
-            --  Swap next entity links in preparation for exchanging entities
+               --  Swap next entity links in preparation for exchanging
+               --  entities.
 
-            Set_Next_Entity (Ren_Id, Next_Entity (Obj_Def_Id));
-            Set_Next_Entity (Obj_Def_Id, Next_Id);
-            Set_Homonym     (Ren_Id, Homonym (Obj_Def_Id));
+               Set_Next_Entity (Ren_Id, Next_Entity (Obj_Def_Id));
+               Set_Next_Entity (Obj_Def_Id, Next_Id);
+               Set_Homonym     (Ren_Id, Homonym (Obj_Def_Id));
 
-            Exchange_Entities (Ren_Id, Obj_Def_Id);
+               Exchange_Entities (Ren_Id, Obj_Def_Id);
 
-            --  Preserve source indication of original declaration, so that
-            --  xref information is properly generated for the right entity.
+               --  Preserve source indication of original declaration, so that
+               --  xref information is properly generated for the right entity.
 
-            Preserve_Comes_From_Source (Obj_Decl, Original_Node (Obj_Decl));
-            Preserve_Comes_From_Source (Obj_Def_Id, Original_Node (Obj_Decl));
+               Preserve_Comes_From_Source (Obj_Decl, Original_Node (Obj_Decl));
+               Preserve_Comes_From_Source
+                 (Obj_Def_Id, Original_Node (Obj_Decl));
 
-            Set_Comes_From_Source (Ren_Id, False);
-         end;
-      end if;
+               Set_Comes_From_Source (Ren_Id, False);
+            end;
+         end if;
+      end;
 
       --  If the object entity has a class-wide Etype, then we need to change
       --  it to the result subtype of the function call, because otherwise the
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index f822545..28950fc 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2763,9 +2763,30 @@ package body Exp_Ch7 is
 
             Stmt := Next_Suitable_Statement (Decl);
 
-            --  Nothing to do for an object with suppressed initialization
+            --  For an object with suppressed initialization, we check whether
+            --  there is in fact no initialization expression. If there is not,
+            --  then this is an object declaration that has been turned into a
+            --  different object declaration that calls the build-in-place
+            --  function in a 'Reference attribute, as in "F(...)'Reference".
+            --  We search for that later object declaration, so that the
+            --  Inc_Decl will be inserted after the call. Otherwise, if the
+            --  call raises an exception, we will finalize the (uninitialized)
+            --  object, which is wrong.
 
             if No_Initialization (Decl) then
+               if No (Expression (Last_Init)) then
+                  loop
+                     Last_Init := Next (Last_Init);
+                     exit when No (Last_Init);
+                     exit when Nkind (Last_Init) = N_Object_Declaration
+                       and then Nkind (Expression (Last_Init)) = N_Reference
+                       and then Nkind (Prefix (Expression (Last_Init))) =
+                                  N_Function_Call
+                       and then Is_Expanded_Build_In_Place_Call
+                                  (Prefix (Expression (Last_Init)));
+                  end loop;
+               end if;
+
                return;
 
             --  In all other cases the initialization calls follow the related
@@ -2955,7 +2976,7 @@ package body Exp_Ch7 is
 
          if No (Finalizer_Insert_Nod) then
 
-            --  Insertion after an abort deffered block
+            --  Insertion after an abort deferred block
 
             if Present (Body_Ins) then
                Finalizer_Insert_Nod := Body_Ins;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index cf6a561..ff1a752 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8274,79 +8274,6 @@ package body Exp_Util is
           and then not Is_Build_In_Place_Function_Call (Prefix (Expr));
    end Is_Non_BIP_Func_Call;
 
-   ------------------------------------
-   -- Is_Object_Access_BIP_Func_Call --
-   ------------------------------------
-
-   function Is_Object_Access_BIP_Func_Call
-      (Expr   : Node_Id;
-       Obj_Id : Entity_Id) return Boolean
-   is
-      Access_Nam : Name_Id := No_Name;
-      Actual     : Node_Id;
-      Call       : Node_Id;
-      Formal     : Node_Id;
-      Param      : Node_Id;
-
-   begin
-      --  Build-in-place calls usually appear in 'reference format. Note that
-      --  the accessibility check machinery may add an extra 'reference due to
-      --  side effect removal.
-
-      Call := Expr;
-      while Nkind (Call) = N_Reference loop
-         Call := Prefix (Call);
-      end loop;
-
-      if Nkind_In (Call, N_Qualified_Expression,
-                         N_Unchecked_Type_Conversion)
-      then
-         Call := Expression (Call);
-      end if;
-
-      if Is_Build_In_Place_Function_Call (Call) then
-
-         --  Examine all parameter associations of the function call
-
-         Param := First (Parameter_Associations (Call));
-         while Present (Param) loop
-            if Nkind (Param) = N_Parameter_Association
-              and then Nkind (Selector_Name (Param)) = N_Identifier
-            then
-               Formal := Selector_Name (Param);
-               Actual := Explicit_Actual_Parameter (Param);
-
-               --  Construct the name of formal BIPaccess. It is much easier to
-               --  extract the name of the function using an arbitrary formal's
-               --  scope rather than the Name field of Call.
-
-               if Access_Nam = No_Name and then Present (Entity (Formal)) then
-                  Access_Nam :=
-                    New_External_Name
-                      (Chars (Scope (Entity (Formal))),
-                       BIP_Formal_Suffix (BIP_Object_Access));
-               end if;
-
-               --  A match for BIPaccess => Obj_Id'Unrestricted_Access has been
-               --  found.
-
-               if Chars (Formal) = Access_Nam
-                 and then Nkind (Actual) = N_Attribute_Reference
-                 and then Attribute_Name (Actual) = Name_Unrestricted_Access
-                 and then Nkind (Prefix (Actual)) = N_Identifier
-                 and then Entity (Prefix (Actual)) = Obj_Id
-               then
-                  return True;
-               end if;
-            end if;
-
-            Next (Param);
-         end loop;
-      end if;
-
-      return False;
-   end Is_Object_Access_BIP_Func_Call;
-
    ----------------------------------
    -- Is_Possibly_Unaligned_Object --
    ----------------------------------
@@ -8739,11 +8666,7 @@ package body Exp_Util is
          Call := Prefix (Call);
       end loop;
 
-      if Nkind_In (Call, N_Qualified_Expression,
-                         N_Unchecked_Type_Conversion)
-      then
-         Call := Expression (Call);
-      end if;
+      Call := Unqual_Conv (Call);
 
       if Is_Build_In_Place_Function_Call (Call) then
 
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 1873cb1..70ae80b 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -774,12 +774,6 @@ package Exp_Util is
    function Is_Non_BIP_Func_Call (Expr : Node_Id) return Boolean;
    --  Determine whether node Expr denotes a non build-in-place function call
 
-   function Is_Object_Access_BIP_Func_Call
-      (Expr   : Node_Id;
-       Obj_Id : Entity_Id) return Boolean;
-   --  Determine if Expr denotes a build-in-place function which stores its
-   --  result in the BIPaccess actual parameter whose prefix must match Obj_Id.
-
    function Is_Possibly_Unaligned_Object (N : Node_Id) return Boolean;
    --  Node N is an object reference. This function returns True if it is
    --  possible that the object may not be aligned according to the normal
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index b0f4b93..58c46a9 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -810,10 +810,15 @@ package body Ch6 is
                      end if;
                   end if;
 
-                  --  Fall through if we have a likely expression function
+                  --  Fall through if we have a likely expression function.
+                  --  If the starting keyword is not "function" the error
+                  --  will be reported elsewhere.
+
+                  if Func then
+                     Error_Msg_SC
+                       ("expression function must be enclosed in parentheses");
+                  end if;
 
-                  Error_Msg_SC
-                    ("expression function must be enclosed in parentheses");
                   return True;
                end Likely_Expression_Function;
 
@@ -844,12 +849,20 @@ package body Ch6 is
 
                   --  This case is correctly processed by the parser because
                   --  the expression function first appears as a subprogram
-                  --  declaration to the parser.
+                  --  declaration to the parser. The starting keyword may
+                  --  not have been "function" in which case the error is
+                  --  on a malformed procedure.
 
                   if Is_Non_Empty_List (Aspects) then
-                     Error_Msg
-                       ("aspect specifications must come after parenthesized "
-                        & "expression", Sloc (First (Aspects)));
+                     if Func then
+                        Error_Msg ("aspect specifications must come after "
+                          & "parenthesized expression",
+                            Sloc (First (Aspects)));
+                     else
+                        Error_Msg ("aspect specifications must come after "
+                          & "subprogram specification",
+                            Sloc (First (Aspects)));
+                     end if;
                   end if;
 
                   --  Parse out expression and build expression function
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 991f2b5..feef95a 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1394,6 +1394,7 @@ package body Sem_Attr is
 
          elsif not Nkind_In (Subp_Decl, N_Abstract_Subprogram_Declaration,
                                         N_Entry_Declaration,
+                                        N_Expression_Function,
                                         N_Generic_Subprogram_Declaration,
                                         N_Subprogram_Body,
                                         N_Subprogram_Body_Stub,
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7ef2834..a99d2ee 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -8700,6 +8700,9 @@ package body Sem_Ch13 is
             FBody : Node_Id;
 
          begin
+            Set_Ekind (SIdB, E_Function);
+            Set_Is_Predicate_Function (SIdB);
+
             --  The predicate function is shared between views of a type
 
             if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
@@ -12664,6 +12667,7 @@ package body Sem_Ch13 is
       ------------------
 
       function Resolve_Name (N : Node_Id) return Traverse_Result is
+         Dummy : Traverse_Result;
       begin
          if Nkind (N) = N_Selected_Component then
             if Nkind (Prefix (N)) = N_Identifier
@@ -12681,6 +12685,12 @@ package body Sem_Ch13 is
                Set_Entity (N, Empty);
             end if;
 
+         --  The name is component association needs no resolution.
+
+         elsif Nkind (N) = N_Component_Association then
+            Dummy := Resolve_Name (Expression (N));
+            return Skip;
+
          elsif Nkind (N) = N_Quantified_Expression then
             return Skip;
          end if;
@@ -12722,14 +12732,19 @@ package body Sem_Ch13 is
                      | Aspect_Static_Predicate
                   =>
                      --  Build predicate function specification and preanalyze
-                     --  expression after type replacement.
+                     --  expression after type replacement. The function
+                     --  declaration must be analyzed in the scope of the
+                     --  type, but the expression must see components.
 
                      if No (Predicate_Function (E)) then
+                        Uninstall_Discriminants_And_Pop_Scope (E);
                         declare
                            FDecl : constant Node_Id :=
                                      Build_Predicate_Function_Declaration (E);
                            pragma Unreferenced (FDecl);
+
                         begin
+                           Push_Scope_And_Install_Discriminants (E);
                            Resolve_Aspect_Expression (Expr);
                         end;
                      end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 83ca58a..7e22255 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11588,6 +11588,12 @@ package body Sem_Ch6 is
 
       if Ekind (Subp) = E_Procedure and then Is_Null_Init_Proc (Subp) then
          return;
+
+      --  Within a predicate function we do not want to generate local
+      --  subtypes that may generate nested predicate functions.
+
+      elsif Is_Subprogram (Subp) and then Is_Predicate_Function (Subp) then
+         return;
       end if;
 
       --  The subtype declarations may freeze the formals. The body generated
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index f4cd375..f96c073 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -402,6 +402,18 @@ package body Sem_Ch7 is
                      end if;
                   end if;
 
+               --  Freeze node
+
+               elsif Nkind (Decl) = N_Freeze_Entity then
+                  declare
+                     Discard : Boolean;
+                     pragma Unreferenced (Discard);
+                  begin
+                     --  Inspect the actions to find references to subprograms
+
+                     Discard := Has_Referencer (Actions (Decl));
+                  end;
+
                --  Exceptions, objects and renamings do not need to be public
                --  if they are not followed by a construct which can reference
                --  and export them. The Is_Public flag is reset on top level
@@ -484,7 +496,7 @@ package body Sem_Ch7 is
 
          --  Local variables
 
-         Discard : Boolean := True;
+         Discard : Boolean;
          pragma Unreferenced (Discard);
 
       --  Start of processing for Hide_Public_Entities
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index d0c4387..bb36584 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7138,6 +7138,24 @@ package body Sem_Prag is
                Set_Treat_As_Volatile (Underlying_Type (E));
             end if;
 
+            --  Apply Volatile to the composite type's individual components,
+            --  (RM C.6(8/3)).
+
+            if Prag_Id = Pragma_Volatile
+              and then Is_Record_Type (Etype (E))
+            then
+               declare
+                  Comp : Entity_Id;
+               begin
+                  Comp := First_Component (E);
+                  while Present (Comp) loop
+                     Mark_Component_Or_Object (Comp);
+
+                     Next_Component (Comp);
+                  end loop;
+               end;
+            end if;
+
          --  Deal with the case where the pragma/attribute applies to a
          --  component or object declaration.
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 237d410..3ca92ce 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -15734,22 +15734,10 @@ package body Sem_Util is
    --------------------------------------
 
    function Is_Validation_Variable_Reference (N : Node_Id) return Boolean is
-      Var    : Node_Id;
+      Var    : constant Node_Id := Unqual_Conv (N);
       Var_Id : Entity_Id;
 
    begin
-      Var := N;
-
-      --  Use the expression when the context qualifies a reference in some
-      --  fashion.
-
-      while Nkind_In (Var, N_Qualified_Expression,
-                           N_Type_Conversion,
-                           N_Unchecked_Type_Conversion)
-      loop
-         Var := Expression (Var);
-      end loop;
-
       Var_Id := Empty;
 
       if Is_Entity_Name (Var) then
@@ -22497,6 +22485,28 @@ package body Sem_Util is
       end if;
    end Unqualify;
 
+   -----------------
+   -- Unqual_Conv --
+   -----------------
+
+   function Unqual_Conv (Expr : Node_Id) return Node_Id is
+   begin
+      --  Recurse to handle unlikely case of multiple levels of qualification
+      --  and/or conversion.
+
+      if Nkind_In (Expr, N_Qualified_Expression,
+                         N_Type_Conversion,
+                         N_Unchecked_Type_Conversion)
+      then
+         return Unqual_Conv (Expression (Expr));
+
+      --  Normal case, not a qualified expression
+
+      else
+         return Expr;
+      end if;
+   end Unqual_Conv;
+
    -----------------------
    -- Visible_Ancestors --
    -----------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 2c29dde..bc76224 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2571,6 +2571,11 @@ package Sem_Util is
    --  Removes any qualifications from Expr. For example, for T1'(T2'(X)), this
    --  returns X. If Expr is not a qualified expression, returns Expr.
 
+   function Unqual_Conv (Expr : Node_Id) return Node_Id;
+   pragma Inline (Unqual_Conv);
+   --  Similar to Unqualify, but removes qualified expressions, type
+   --  conversions, and unchecked conversions.
+
    function Visible_Ancestors (Typ : Entity_Id) return Elist_Id;
    --  [Ada 2012:AI-0125-1]: Collect all the visible parents and progenitors
    --  of a type extension or private extension declaration. If the full-view