[multiple changes]

2017-10-19  Bob Duff  <duff@adacore.com>

	* exp_util.adb: (Process_Statements_For_Controlled_Objects): Clarify
	which node kinds can legitimately be ignored, and raise Program_Error
	for others.

2017-10-19  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_elab.adb (Compilation_Unit): Handle the case of a subprogram
	instantiation that acts as a compilation unit.
	(Find_Code_Unit): Reimplemented.
	(Find_Top_Unit): Reimplemented.
	(Find_Unit_Entity): New routine.
	(Process_Instantiation_SPARK): Correct the elaboration requirement a
	package instantiation imposes on a unit.

2017-10-19  Bob Duff  <duff@adacore.com>

	* exp_ch6.adb (Is_Build_In_Place_Result_Type): Enable build-in-place
	for a narrow set of controlled types.

2017-10-19  Eric Botcazou  <ebotcazou@adacore.com>

	* sinput.ads (Line_Start): Add pragma Inline.
	* widechar.ads (Is_Start_Of_Wide_Char): Likewise.

2017-10-19  Bob Duff  <duff@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Disable
	Make_Build_In_Place_Call_... for F(...)'Old, where F(...) is a
	build-in-place function call so that the temp is declared in the right
	place.

From-SVN: r253915

gcc/ada/ChangeLog

+2017-10-19  Bob Duff  <duff@adacore.com>
+
+	* exp_util.adb: (Process_Statements_For_Controlled_Objects): Clarify
+	which node kinds can legitimately be ignored, and raise Program_Error
+	for others.
+
+2017-10-19  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_elab.adb (Compilation_Unit): Handle the case of a subprogram
+	instantiation that acts as a compilation unit.
+	(Find_Code_Unit): Reimplemented.
+	(Find_Top_Unit): Reimplemented.
+	(Find_Unit_Entity): New routine.
+	(Process_Instantiation_SPARK): Correct the elaboration requirement a
+	package instantiation imposes on a unit.
+
+2017-10-19  Bob Duff  <duff@adacore.com>
+
+	* exp_ch6.adb (Is_Build_In_Place_Result_Type): Enable build-in-place
+	for a narrow set of controlled types.
+
+2017-10-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sinput.ads (Line_Start): Add pragma Inline.
+	* widechar.ads (Is_Start_Of_Wide_Char): Likewise.
+
+2017-10-19  Bob Duff  <duff@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference): Disable
+	Make_Build_In_Place_Call_... for F(...)'Old, where F(...) is a
+	build-in-place function call so that the temp is declared in the right
+	place.
+
 2017-10-18  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/misc.c (gnat_tree_size): Move around.

gcc/ada/exp_attr.adb

@@ -1756,7 +1756,19 @@ package body Exp_Attr is
       --  and access to it must be passed to the function.
 
       if Is_Build_In_Place_Function_Call (Pref) then
-         Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
+
+         --  If attribute is 'Old, the context is a postcondition, and
+         --  the temporary must go in the corresponding subprogram, not
+         --  the postcondition function or any created blocks, as when
+         --  the attribute appears in a quantified expression. This is
+         --  handled below in the expansion of the attribute.
+
+         if Attribute_Name (Parent (Pref)) = Name_Old then
+            null;
+
+         else
+            Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
+         end if;
 
       --  Ada 2005 (AI-318-02): Specialization of the previous case for prefix
       --  containing build-in-place function calls whose returned object covers

gcc/ada/exp_ch6.adb

@@ -7240,34 +7240,58 @@ package body Exp_Ch6 is
       if Is_Limited_View (Typ) then
          return Ada_Version >= Ada_2005 and then not Debug_Flag_Dot_L;
       else
---         if Debug_Flag_Dot_9 then
-         if True then
-            return False; -- ???disable bip for nonlimited types
-         end if;
-
          if Has_Interfaces (Typ) then
             return False;
          end if;
 
-         --  For T'Class, return True if it's True for the corresponding
-         --  specific type. This is necessary because a class-wide function
-         --  might say "return F (...)", where F returns the corresponding
-         --  specific type.
-
-         if Is_Class_Wide_Type (Typ) then
-            return Is_Build_In_Place_Result_Type (Etype (Typ));
-         end if;
-
          declare
             T : Entity_Id := Typ;
          begin
-            if Present (Underlying_Type (Typ)) then
+            --  For T'Class, return True if it's True for T. This is necessary
+            --  because a class-wide function might say "return F (...)", where
+            --  F returns the corresponding specific type.
+
+            if Is_Class_Wide_Type (Typ) then
+               T := Etype (Typ);
+            end if;
+
+            --  If this is a generic formal type in an instance, return True if
+            --  it's True for the generic actual type.
+
+            if Nkind (Parent (Typ)) = N_Subtype_Declaration
+              and then Present (Generic_Parent_Type (Parent (Typ)))
+            then
+               T := Entity (Subtype_Indication (Parent (Typ)));
+
+               if Present (Full_View (T)) then
+                  T := Full_View (T);
+               end if;
+
+            elsif Present (Underlying_Type (Typ)) then
                T := Underlying_Type (Typ);
             end if;
 
             declare
-               Result : constant Boolean := Is_Controlled (T);
+               Result : Boolean;
             begin
+               --  ???For now, enable build-in-place for a very narrow set of
+               --  controlled types. Change "if True" to "if False" to
+               --  experiment more controlled types. Eventually, we would
+               --  like to enable build-in-place for all tagged types, all
+               --  types that need finalization, and all caller-unknown-size
+               --  types. We will eventually use Debug_Flag_Dot_9 to disable
+               --  build-in-place for nonlimited types.
+
+--         if Debug_Flag_Dot_9 then
+               if True then
+                  Result := Is_Controlled (T)
+                    and then Present (Enclosing_Subprogram (T))
+                    and then not Is_Compilation_Unit (Enclosing_Subprogram (T))
+                    and then Ekind (Enclosing_Subprogram (T)) = E_Procedure;
+               else
+                  Result := Is_Controlled (T);
+               end if;
+
                return Result;
             end;
          end;

gcc/ada/exp_util.adb

@@ -10817,8 +10817,14 @@ package body Exp_Util is
                Analyze (Block);
             end if;
 
-         when others =>
+         --  Could be e.g. a loop that was transformed into a block or null
+         --  statement. Do nothing for terminate alternatives.
+
+         when N_Block_Statement | N_Null_Statement | N_Terminate_Alternative =>
             null;
+
+         when others =>
+            raise Program_Error;
       end case;
    end Process_Statements_For_Controlled_Objects;
 

gcc/ada/sem_elab.adb

@@ -159,7 +159,7 @@ package body Sem_Elab is
    --
    --      -  Instantiations
    --
-   --      -  References to variables
+   --      -  Reads of variables
    --
    --      -  Task activation
    --
@@ -175,7 +175,7 @@ package body Sem_Elab is
    --
    --      - For instantiations, the target is the generic template
    --
-   --      - For references to variables, the target is the variable
+   --      - For reads of variables, the target is the variable
    --
    --      - For task activation, the target is the task body
    --
@@ -883,6 +883,10 @@ package body Sem_Elab is
    --  is obtained by logically unwinding instantiations and subunits when N
    --  resides within one.
 
+   function Find_Unit_Entity (N : Node_Id) return Entity_Id;
+   pragma Inline (Find_Unit_Entity);
+   --  Return the entity of unit N
+
    function First_Formal_Type (Subp_Id : Entity_Id) return Entity_Id;
    pragma Inline (First_Formal_Type);
    --  Return the type of subprogram Subp_Id's first formal parameter. If the
@@ -1904,7 +1908,20 @@ package body Sem_Elab is
          Comp_Unit := Parent (Unit_Declaration_Node (Unit_Id));
       end if;
 
-      if Nkind (Comp_Unit) = N_Subunit then
+      --  Handle the case where a subprogram instantiation which acts as a
+      --  compilation unit is expanded into an anonymous package that wraps
+      --  the instantiated subprogram.
+
+      if Nkind (Comp_Unit) = N_Package_Specification
+        and then Nkind_In (Original_Node (Parent (Comp_Unit)),
+                           N_Function_Instantiation,
+                           N_Procedure_Instantiation)
+      then
+         Comp_Unit := Parent (Parent (Comp_Unit));
+
+      --  Handle the case where the compilation unit is a subunit
+
+      elsif Nkind (Comp_Unit) = N_Subunit then
          Comp_Unit := Parent (Comp_Unit);
       end if;
 
@@ -2933,10 +2950,8 @@ package body Sem_Elab is
    --------------------
 
    function Find_Code_Unit (N : Node_Or_Entity_Id) return Entity_Id is
-      N_Unit : constant Node_Id := Unit (Cunit (Get_Code_Unit (N)));
-
    begin
-      return Defining_Entity (N_Unit, Concurrent_Subunit => True);
+      return Find_Unit_Entity (Unit (Cunit (Get_Code_Unit (N))));
    end Find_Code_Unit;
 
    ---------------------------
@@ -3405,12 +3420,47 @@ package body Sem_Elab is
    -------------------
 
    function Find_Top_Unit (N : Node_Or_Entity_Id) return Entity_Id is
-      N_Unit : constant Node_Id := Unit (Cunit (Get_Top_Level_Code_Unit (N)));
-
    begin
-      return Defining_Entity (N_Unit, Concurrent_Subunit => True);
+      return Find_Unit_Entity (Unit (Cunit (Get_Top_Level_Code_Unit (N))));
    end Find_Top_Unit;
 
+   ----------------------
+   -- Find_Unit_Entity --
+   ----------------------
+
+   function Find_Unit_Entity (N : Node_Id) return Entity_Id is
+      Context : constant Node_Id := Parent (N);
+      Orig_N  : constant Node_Id := Original_Node (N);
+
+   begin
+      --  The unit denotes a package body of an instantiation which acts as
+      --  a compilation unit. The proper entity is that of the package spec.
+
+      if Nkind (N) = N_Package_Body
+        and then Nkind (Orig_N) = N_Package_Instantiation
+        and then Nkind (Context) = N_Compilation_Unit
+      then
+         return Corresponding_Spec (N);
+
+      --  The unit denotes an anonymous package created to wrap a subprogram
+      --  instantiation which acts as a compilation unit. The proper entity is
+      --  that of the "related instance".
+
+      elsif Nkind (N) = N_Package_Declaration
+        and then Nkind_In (Orig_N, N_Function_Instantiation,
+                                   N_Procedure_Instantiation)
+        and then Nkind (Context) = N_Compilation_Unit
+      then
+         return
+           Related_Instance (Defining_Entity (N, Concurrent_Subunit => True));
+
+      --  Otherwise the proper entity is the defining entity
+
+      else
+         return Defining_Entity (N, Concurrent_Subunit => True);
+      end if;
+   end Find_Unit_Entity;
+
    -----------------------
    -- First_Formal_Type --
    -----------------------
@@ -5335,8 +5385,8 @@ package body Sem_Elab is
          --  in a great number of contexts. To determine whether a reference is
          --  a read, it is more practical to find out whether it is a write.
 
-         --  A reference is a write when appearing immediately on the left-hand
-         --  side of an assignment.
+         --  A reference is a write when it appears immediately on the left-
+         --  hand side of an assignment.
 
          if Nkind (Context) = N_Assignment_Statement
            and then Name (Context) = Ref
@@ -7796,9 +7846,9 @@ package body Sem_Elab is
       --  ABE ramifications of the instantiation.
 
       if Nkind (Inst) = N_Package_Instantiation then
-         Req_Nam := Name_Elaborate;
-      else
          Req_Nam := Name_Elaborate_All;
+      else
+         Req_Nam := Name_Elaborate;
       end if;
 
       Meet_Elaboration_Requirement
@@ -8155,10 +8205,10 @@ package body Sem_Elab is
       --  listed below are not considered. The categories are:
 
       --   'Access for entries, operators, and subprograms
+      --    Assignments to variables
       --    Calls (includes task activation)
       --    Instantiations
-      --    Variable assignments
-      --    Variable references
+      --    Reads of variables
 
       elsif Is_Suitable_Access (N)
         or else Is_Suitable_Variable_Assignment (N)

gcc/ada/sinput.ads

@@ -755,6 +755,8 @@ private
    pragma Inline (Num_Source_Files);
    pragma Inline (Num_Source_Lines);
 
+   pragma Inline (Line_Start);
+
    No_Instance_Id : constant Instance_Id := 0;
 
    -------------------------

gcc/ada/widechar.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, 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- --
@@ -95,4 +95,7 @@ package Widechar is
       P : Source_Ptr) return Boolean;
    --  Determines if S (P) is the start of a wide character sequence
 
+private
+   pragma Inline (Is_Start_Of_Wide_Char);
+
 end Widechar;