public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Ada] Build in place for nonlimited types
@ 2017-09-29 13:49 Pierre-Marie de Rodat
  0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2017-09-29 13:49 UTC (permalink / raw)
  To: gcc-patches; +Cc: Bob Duff

[-- Attachment #1: Type: text/plain, Size: 3570 bytes --]

First cut at build-in-place for nonlimited types.
This is a work in progress; the build-in-place
support is currently disabled.

Tested on x86_64-pc-linux-gnu, committed on trunk

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

	* exp_ch6.adb (Expand_Call_Helper): Handle case of build-in-place
	functions returning nonlimited types. Allow for qualified expressions
	and type conversions.
	(Expand_N_Extended_Return_Statement): Correct the computation of
	Func_Bod to allow for child units.
	(Expand_Simple_Function_Return): Remove assumption that b-i-p implies
	limited (initialization of In_Place_Expansion), and implies >= Ada
	2005.
	(Is_Build_In_Place_Result_Type): New function to accompany
	Is_Build_In_Place_Function and Is_Build_In_Place_Function_Call, because
	sometimes we just have the type on our hands, not the function.  For
	now, does the same thing as the old version, so build-in-place is
	disabled for nonlimited types, except that you can use -gnatd.9 to
	enable it.
	* exp_ch6.ads (Is_Build_In_Place_Result_Type): New function to
	accompany Is_Build_In_Place_Function and
	Is_Build_In_Place_Function_Call, because sometimes we just have the
	type on our hands, not the function.
	(Make_Build_In_Place_Call_In_...): Handle nonlimited build-in-place
	cases.
	(Make_Build_In_Place_Call_In_Object_Declaration): Remove the
	questionable code at the end that was setting the Etype.
	* exp_aggr.adb (Is_Build_In_Place_Aggregate_Return): New function to
	determine whether "return (...agg...);" is returning from a
	build-in-place function.
	(Initialize_Ctrl_Array_Component, Initialize_Ctrl_Record_Component):
	Remove assumption that b-i-p implies limited (initialization of
	In_Place_Expansion).
	(Build_Record_Aggr_Code): AI-287: fix comment; it can't be wrapped in
	an unchecked conversion.  Add assertions.
	(Convert_Aggr_In_Object_Decl): Establish_Transient_Scope -- no need for
	secondary stack here, just because the type needs finalization.  That
	code is obsolete.
	(Convert_To_Assignments): Only set Unc_Decl if Nkind (N) = N_Aggregate.
	For "return (...agg...);" don't assume b-i-p implies limited.
	Needs_Finalization does not imply secondary stack.
	(Expand_Array_Aggregate): Named notation.  Reverse the sense of
	Component_OK_For_Backend -- more readability with fewer double
	negatives.
	* exp_attr.adb (Expand_N_Attribute_Reference): Remove assumptions that
	b-i-p implies >= Ada 2005.
	* exp_ch3.adb (Expand_N_Object_Declaration): Remove assumptions that
	b-i-p implies >= Ada 2005.  Remove Adjust if we're building the return
	object of an extended return statement in place.
	* exp_ch4.adb (Expand_Allocator_Expression, Expand_N_Indexed_Component,
	Expand_N_Selected_Component, Expand_N_Slice): Remove assumptions that
	b-i-p implies >= Ada 2005.
	* exp_ch5.adb (Expand_N_Assignment_Statement): Remove assumption that
	b-i-p implies >= Ada 2005.
	* exp_ch7.adb: Comment fix.
	* exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Remove
	assumptions that b-i-p implies >= Ada 2005.
	* exp_disp.adb (Expand_Interface_Actuals): Remove assumptions that
	b-i-p implies >= Ada 2005.
	* exp_util.adb (Build_Allocate_Deallocate_Proc): Look at Storage_Pool
	(Expr), in case Pool_Id is not set.
	(Initialized_By_Aliased_BIP_Func_Call): Handle case where the call is
	qualified or converted.
	(Is_Secondary_Stack_BIP_Func_Call): Don't check if Nkind (Selector_Name
	(Param)) = N_Identifier; that's all it could be.
	* sinfo.ads: Comment fixes.
	* snames.ads-tmpl: Comment fixes.
	* debug.adb: Add flag gnatd.9, to enable the build-in-place machinery.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 54489 bytes --]

Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb	(revision 253285)
+++ exp_aggr.adb	(working copy)
@@ -175,6 +175,10 @@
    -- Local subprograms for Record Aggregate Expansion --
    ------------------------------------------------------
 
+   function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean;
+   --  True if N is an aggregate (possibly qualified or converted) that is
+   --  being returned from a build-in-place function.
+
    function Build_Record_Aggr_Code
      (N   : Node_Id;
       Typ : Entity_Id;
@@ -186,10 +190,9 @@
    --  types.
 
    procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id);
-   --  N is an N_Aggregate or an N_Extension_Aggregate. Typ is the type of the
-   --  aggregate (which can only be a record type, this procedure is only used
-   --  for record types). Transform the given aggregate into a sequence of
-   --  assignments performed component by component.
+   --  Transform a record aggregate into a sequence of assignments performed
+   --  component by component.  N is an N_Aggregate or N_Extension_Aggregate.
+   --  Typ is the type of the record aggregate.
 
    procedure Expand_Record_Aggregate
      (N           : Node_Id;
@@ -762,10 +765,10 @@
       --  Checks 5 (if the component type is tagged, then we may need to do
       --  tag adjustments. Perhaps this should be refined to check for any
       --  component associations that actually need tag adjustment, similar
-      --  to the test in Component_Not_OK_For_Backend for record aggregates
-      --  with tagged components, but not clear whether it's worthwhile ???;
-      --  in the case of virtual machines (no Tagged_Type_Expansion), object
-      --  tags are handled implicitly).
+      --  to the test in Component_OK_For_Backend for record aggregates with
+      --  tagged components, but not clear whether it's worthwhile ???; in the
+      --  case of virtual machines (no Tagged_Type_Expansion), object tags are
+      --  handled implicitly).
 
       if Is_Tagged_Type (Component_Type (Typ))
         and then Tagged_Type_Expansion
@@ -1347,7 +1350,7 @@
 
             In_Place_Expansion :=
               Nkind (Expr) = N_Function_Call
-                and then not Is_Limited_Type (Comp_Typ);
+                and then not Is_Build_In_Place_Result_Type (Comp_Typ);
 
             --  The initialization expression is a controlled function call.
             --  Perform in-place removal of side effects to avoid creating a
@@ -2831,7 +2834,7 @@
 
          In_Place_Expansion :=
            Nkind (Init_Expr) = N_Function_Call
-             and then not Is_Limited_Type (Comp_Typ);
+                and then not Is_Build_In_Place_Result_Type (Comp_Typ);
 
          --  The initialization expression is a controlled function call.
          --  Perform in-place removal of side effects to avoid creating a
@@ -2967,7 +2970,10 @@
 
          --    [Deep_]Adjust (Rec_Comp);
 
-         if Finalization_OK and then not Is_Limited_Type (Comp_Typ) then
+         if Finalization_OK
+           and then not Is_Limited_Type (Comp_Typ)
+           and then not Is_Build_In_Place_Function_Call (Init_Expr)
+         then
             Adj_Call :=
               Make_Adjust_Call
                 (Obj_Ref => New_Copy_Tree (Rec_Comp),
@@ -3229,13 +3235,9 @@
             --  Ada 2005 (AI-287): If the ancestor part is an aggregate of
             --  limited type, a recursive call expands the ancestor. Note that
             --  in the limited case, the ancestor part must be either a
-            --  function call (possibly qualified, or wrapped in an unchecked
-            --  conversion) or aggregate (definitely qualified).
+            --  function call (possibly qualified) or aggregate (definitely
+            --  qualified).
 
-            --  The ancestor part can also be a function call (that may be
-            --  transformed into an explicit dereference) or a qualification
-            --  of one such.
-
             elsif Is_Limited_Type (Etype (Ancestor))
               and then Nkind_In (Unqualify (Ancestor), N_Aggregate,
                                                        N_Extension_Aggregate)
@@ -3330,6 +3332,7 @@
 
                if Needs_Finalization (Etype (Ancestor))
                  and then not Is_Limited_Type (Etype (Ancestor))
+                 and then not Is_Build_In_Place_Function_Call (Ancestor)
                then
                   Adj_Call :=
                     Make_Adjust_Call
@@ -3351,6 +3354,10 @@
                   Check_Ancestor_Discriminants (Init_Typ);
                end if;
             end if;
+
+            pragma Assert (Nkind (N) = N_Extension_Aggregate);
+            pragma Assert
+              (not (Ancestor_Is_Expression and Ancestor_Is_Subtype_Mark));
          end;
 
          --  Generate assignments of hidden discriminants. If the base type is
@@ -4073,10 +4080,7 @@
         and then Ekind (Current_Scope) /= E_Return_Statement
         and then not Is_Limited_Type (Typ)
       then
-         Establish_Transient_Scope
-           (Aggr,
-            Sec_Stack =>
-              Is_Controlled (Typ) or else Has_Controlled_Component (Typ));
+         Establish_Transient_Scope (Aggr, Sec_Stack => False);
       end if;
 
       declare
@@ -4121,6 +4125,25 @@
    -- Convert_To_Assignments --
    ----------------------------
 
+   function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean is
+      P : Node_Id := Parent (N);
+   begin
+      while Nkind (P) = N_Qualified_Expression loop
+         P := Parent (P);
+      end loop;
+
+      if Nkind (P) = N_Simple_Return_Statement then
+         null;
+      elsif Nkind (Parent (P)) = N_Extended_Return_Statement then
+         P := Parent (P);
+      else
+         return False;
+      end if;
+
+      return Is_Build_In_Place_Function
+        (Return_Applies_To (Return_Statement_Entity (P)));
+   end Is_Build_In_Place_Aggregate_Return;
+
    procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
       T    : Entity_Id;
@@ -4134,6 +4157,7 @@
       Parent_Node : Node_Id;
 
    begin
+      pragma Assert (Nkind_In (N, N_Aggregate, N_Extension_Aggregate));
       pragma Assert (not Is_Static_Dispatch_Table_Aggregate (N));
       pragma Assert (Is_Record_Type (Typ));
 
@@ -4141,10 +4165,9 @@
       Parent_Kind := Nkind (Parent_Node);
 
       if Parent_Kind = N_Qualified_Expression then
-
-         --  Check if we are in a unconstrained declaration because in this
+         --  Check if we are in an unconstrained declaration because in this
          --  case the current delayed expansion mechanism doesn't work when
-         --  the declared object size depend on the initializing expr.
+         --  the declared object size depends on the initializing expr.
 
          Parent_Node := Parent (Parent_Node);
          Parent_Kind := Nkind (Parent_Node);
@@ -4152,8 +4175,9 @@
          if Parent_Kind = N_Object_Declaration then
             Unc_Decl :=
               not Is_Entity_Name (Object_Definition (Parent_Node))
-                or else Has_Discriminants
-                          (Entity (Object_Definition (Parent_Node)))
+                or else (Nkind (N) = N_Aggregate
+                           and then Has_Discriminants
+                             (Entity (Object_Definition (Parent_Node))))
                 or else Is_Class_Wide_Type
                           (Entity (Object_Definition (Parent_Node)));
          end if;
@@ -4195,11 +4219,7 @@
          --  finalization of the return object (which is built in place
          --  within the caller's scope).
 
-         or else
-           (Is_Limited_View (Typ)
-             and then
-               (Nkind (Parent (Parent_Node)) = N_Extended_Return_Statement
-                 or else Nkind (Parent_Node) = N_Simple_Return_Statement))
+         or else Is_Build_In_Place_Aggregate_Return (N)
       then
          Set_Expansion_Delayed (N);
          return;
@@ -4214,7 +4234,7 @@
       --  Should the condition be more restrictive ???
 
       if Requires_Transient_Scope (Typ) and then not Inside_Init_Proc then
-         Establish_Transient_Scope (N, Sec_Stack => Needs_Finalization (Typ));
+         Establish_Transient_Scope (N, Sec_Stack => False);
       end if;
 
       --  If the aggregate is nonlimited, create a temporary. If it is limited
@@ -6111,8 +6131,7 @@
       --  for default initialization, e.g. with Initialize_Scalars.
 
       if Requires_Transient_Scope (Typ) then
-         Establish_Transient_Scope
-           (N, Sec_Stack => Has_Controlled_Component (Typ));
+         Establish_Transient_Scope (N, Sec_Stack => False);
       end if;
 
       if Has_Default_Init_Comps (N) then
@@ -6251,7 +6270,7 @@
          if Ekind (Current_Scope) = E_Loop
            and then Nkind (Parent (Parent (N))) = N_Allocator
          then
-            Establish_Transient_Scope (N, False);
+            Establish_Transient_Scope (N, Sec_Stack => False);
          end if;
 
          Insert_Action (N, Tmp_Decl);
@@ -6646,13 +6665,13 @@
 
    --  If the ancestor part is an expression, add a component association for
    --  the parent field. If the type of the ancestor part is not the direct
-   --  parent of the expected type,  build recursively the needed ancestors.
-   --  If the ancestor part is a subtype_mark, replace aggregate with a decla-
-   --  ration for a temporary of the expected type, followed by individual
-   --  assignments to the given components.
+   --  parent of the expected type, build recursively the needed ancestors.
+   --  If the ancestor part is a subtype_mark, replace aggregate with a
+   --  declaration for a temporary of the expected type, followed by
+   --  individual assignments to the given components.
 
    procedure Expand_N_Extension_Aggregate (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc  (N);
+      Loc : constant Source_Ptr := Sloc (N);
       A   : constant Node_Id    := Ancestor_Part (N);
       Typ : constant Entity_Id  := Etype (N);
 
@@ -6709,7 +6728,7 @@
       Static_Components : Boolean := True;
       --  Flag to indicate whether all components are compile-time known,
       --  and the aggregate can be constructed statically and handled by
-      --  the back-end.
+      --  the back-end. Set to False by Component_OK_For_Backend.
 
       procedure Build_Back_End_Aggregate;
       --  Build a proper aggregate to be handled by the back-end
@@ -6722,7 +6741,7 @@
       --  This returns true for N_Aggregate with Compile_Time_Known_Aggregate
       --  set and constants whose expression is such an aggregate, recursively.
 
-      function Component_Not_OK_For_Backend return Boolean;
+      function Component_OK_For_Backend return Boolean;
       --  Check for presence of a component which makes it impossible for the
       --  backend to process the aggregate, thus requiring the use of a series
       --  of assignment statements. Cases checked for are a nested aggregate
@@ -6741,6 +6760,9 @@
       --  in order to minimize elaboration code. This is one case where the
       --  semantics of Ada complicate the analysis and lead to anomalies in
       --  the gcc back-end if the aggregate is not expanded into assignments.
+      --
+      --  NOTE: This sets the global Static_Components to False in most, but
+      --  not all, cases when it returns False.
 
       function Has_Per_Object_Constraint (L : List_Id) return Boolean;
       --  Return True if any element of L has Has_Per_Object_Constraint set.
@@ -7043,7 +7065,7 @@
                   --  The ancestor part may be a nested aggregate that has
                   --  delayed expansion: recheck now.
 
-                  if Component_Not_OK_For_Backend then
+                  if not Component_OK_For_Backend then
                      Convert_To_Assignments (N, Typ);
                   end if;
                end;
@@ -7110,17 +7132,17 @@
 
       end Compile_Time_Known_Composite_Value;
 
-      ----------------------------------
-      -- Component_Not_OK_For_Backend --
-      ----------------------------------
+      ------------------------------
+      -- Component_OK_For_Backend --
+      ------------------------------
 
-      function Component_Not_OK_For_Backend return Boolean is
+      function Component_OK_For_Backend return Boolean is
          C      : Node_Id;
          Expr_Q : Node_Id;
 
       begin
          if No (Comps) then
-            return False;
+            return True;
          end if;
 
          C := First (Comps);
@@ -7130,7 +7152,7 @@
             --  and component is not ready for backend.
 
             if Box_Present (C) then
-               return True;
+               return False;
             end if;
 
             if Nkind (Expression (C)) = N_Qualified_Expression then
@@ -7139,7 +7161,7 @@
                Expr_Q := Expression (C);
             end if;
 
-            --  Return true if the aggregate has any associations for tagged
+            --  Return False if the aggregate has any associations for tagged
             --  components that may require tag adjustment.
 
             --  These are cases where the source expression may have a tag that
@@ -7156,36 +7178,36 @@
               and then Tagged_Type_Expansion
             then
                Static_Components := False;
-               return True;
+               return False;
 
             elsif Is_Delayed_Aggregate (Expr_Q) then
                Static_Components := False;
-               return True;
+               return False;
 
             elsif Possible_Bit_Aligned_Component (Expr_Q) then
                Static_Components := False;
-               return True;
+               return False;
 
             elsif Modify_Tree_For_C
               and then Nkind (C) = N_Component_Association
               and then Has_Per_Object_Constraint (Choices (C))
             then
                Static_Components := False;
-               return True;
+               return False;
 
             elsif Modify_Tree_For_C
               and then Nkind (Expr_Q) = N_Identifier
               and then Is_Array_Type (Etype (Expr_Q))
             then
                Static_Components := False;
-               return True;
+               return False;
 
             elsif Modify_Tree_For_C
               and then Nkind (Expr_Q) = N_Type_Conversion
               and then Is_Array_Type (Etype (Expr_Q))
             then
                Static_Components := False;
-               return True;
+               return False;
             end if;
 
             if Is_Elementary_Type (Etype (Expr_Q)) then
@@ -7199,15 +7221,15 @@
                if Is_Private_Type (Etype (Expr_Q))
                  and then Has_Discriminants (Etype (Expr_Q))
                then
-                  return True;
+                  return False;
                end if;
             end if;
 
             Next (C);
          end loop;
 
-         return False;
-      end Component_Not_OK_For_Backend;
+         return True;
+      end Component_OK_For_Backend;
 
       -------------------------------
       -- Has_Per_Object_Constraint --
@@ -7297,7 +7319,7 @@
       --  Ada 2005 (AI-318-2): We need to convert to assignments if components
       --  are build-in-place function calls. The assignments will each turn
       --  into a build-in-place function call. If components are all static,
-      --  we can pass the aggregate to the backend regardless of limitedness.
+      --  we can pass the aggregate to the back end regardless of limitedness.
 
       --  Extension aggregates, aggregates in extended return statements, and
       --  aggregates for C++ imported types must be expanded.
@@ -7314,7 +7336,7 @@
             Convert_To_Assignments (N, Typ);
 
          elsif not Size_Known_At_Compile_Time (Typ)
-           or else Component_Not_OK_For_Backend
+           or else not Component_OK_For_Backend
            or else not Static_Components
          then
             Convert_To_Assignments (N, Typ);
@@ -7349,7 +7371,7 @@
 
       --  Check components
 
-      elsif Component_Not_OK_For_Backend then
+      elsif not Component_OK_For_Backend then
          Convert_To_Assignments (N, Typ);
 
       --  If an ancestor is private, some components are not inherited and we
Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb	(revision 253288)
+++ exp_ch5.adb	(working copy)
@@ -2390,13 +2390,13 @@
             end;
          end if;
 
-      --  Build-in-place function call case. Note that we're not yet doing
-      --  build-in-place for user-written assignment statements (the assignment
-      --  here came from an aggregate.)
+      --  Build-in-place function call case. This is for assignment statements
+      --  that come from aggregate component associations or from init procs.
+      --  User-written assignment statements with b-i-p calls are handled
+      --  elsewhere.
 
-      elsif Ada_Version >= Ada_2005
-        and then Is_Build_In_Place_Function_Call (Rhs)
-      then
+      elsif Is_Build_In_Place_Function_Call (Rhs) then
+         pragma Assert (not Comes_From_Source (N));
          Make_Build_In_Place_Call_In_Assignment (N, Rhs);
 
       elsif Is_Tagged_Type (Typ)
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb	(revision 253283)
+++ exp_ch6.adb	(working copy)
@@ -2252,6 +2252,9 @@
    procedure Expand_Call (N : Node_Id) is
       Post_Call : List_Id;
    begin
+      pragma Assert
+        (Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement,
+                      N_Entry_Call_Statement));
       Expand_Call_Helper (N, Post_Call);
       Insert_Post_Call_Actions (N, Post_Call);
    end Expand_Call;
@@ -4327,29 +4330,30 @@
       --  result from the secondary stack.
 
       if Needs_Finalization (Etype (Subp)) then
-         if not Is_Limited_View (Etype (Subp))
-           and then
-             (No (First_Formal (Subp))
-                or else
-                  not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
-         then
-            Expand_Ctrl_Function_Call (Call_Node);
-
          --  Build-in-place function calls which appear in anonymous contexts
          --  need a transient scope to ensure the proper finalization of the
          --  intermediate result after its use.
 
-         elsif Is_Build_In_Place_Function_Call (Call_Node)
+         if Is_Build_In_Place_Function_Call (Call_Node)
            and then
-             Nkind_In (Parent (Call_Node), N_Attribute_Reference,
-                                           N_Function_Call,
-                                           N_Indexed_Component,
-                                           N_Object_Renaming_Declaration,
-                                           N_Procedure_Call_Statement,
-                                           N_Selected_Component,
-                                           N_Slice)
+             Nkind_In (Parent (Unqual_Conv (Call_Node)),
+                       N_Attribute_Reference,
+                       N_Function_Call,
+                       N_Indexed_Component,
+                       N_Object_Renaming_Declaration,
+                       N_Procedure_Call_Statement,
+                       N_Selected_Component,
+                       N_Slice)
          then
             Establish_Transient_Scope (Call_Node, Sec_Stack => True);
+
+         elsif not Is_Build_In_Place_Function_Call (Call_Node)
+           and then
+             (No (First_Formal (Subp))
+                or else
+                  not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
+         then
+            Expand_Ctrl_Function_Call (Call_Node);
          end if;
       end if;
    end Expand_Call_Helper;
@@ -4756,6 +4760,12 @@
                Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod)));
             end if;
 
+            if Nkind (Func_Bod) = N_Function_Specification then
+               Func_Bod := Parent (Func_Bod); -- one more level for child units
+            end if;
+
+            pragma Assert (Nkind (Func_Bod) = N_Subprogram_Body);
+
             --  Create a flag to track the function state
 
             Flag_Id := Make_Temporary (Loc, 'F');
@@ -4781,8 +4791,7 @@
       --  Build a simple_return_statement that returns the return object when
       --  there is a statement sequence, or no expression, or the result will
       --  be built in place. Note however that we currently do this for all
-      --  composite cases, even though nonlimited composite results are not yet
-      --  built in place (though we plan to do so eventually).
+      --  composite cases, even though not all are built in place.
 
       if Present (HSS)
         or else Is_Composite_Type (Ret_Typ)
@@ -6385,8 +6394,8 @@
       end if;
 
       --  For the case of a simple return that does not come from an extended
-      --  return, in the case of Ada 2005 where we are returning a limited
-      --  type, we rewrite "return <expression>;" to be:
+      --  return, in the case of build-in-place, we rewrite "return
+      --  <expression>;" to be:
 
       --    return _anon_ : <return_subtype> := <expression>
 
@@ -6414,9 +6423,13 @@
       --  class-wide interface type, which is not a limited type, even though
       --  the type of the expression may be.
 
+      pragma Assert
+        (Comes_From_Extended_Return_Statement (N)
+           or else not Is_Build_In_Place_Function_Call (Exp)
+           or else Is_Build_In_Place_Function (Scope_Id));
+
       if not Comes_From_Extended_Return_Statement (N)
-        and then Is_Limited_View (Etype (Expression (N)))
-        and then Ada_Version >= Ada_2005
+        and then Is_Build_In_Place_Function (Scope_Id)
         and then not Debug_Flag_Dot_L
 
          --  The functionality of interface thunks is simple and it is always
@@ -6494,7 +6507,7 @@
       --  type that requires special processing (indicated by the fact that
       --  it requires a cleanup scope for the secondary stack case).
 
-      if Is_Limited_View (Exptyp)
+      if Is_Build_In_Place_Function (Scope_Id)
         or else Is_Limited_Interface (Exptyp)
       then
          null;
@@ -7186,6 +7199,24 @@
       return False;
    end Has_Unconstrained_Access_Discriminants;
 
+   -----------------------------------
+   -- Is_Build_In_Place_Result_Type --
+   -----------------------------------
+
+   function Is_Build_In_Place_Result_Type (Typ : Entity_Id) return Boolean is
+   begin
+      --  In Ada 2005 all functions with an inherently limited return type
+      --  must be handled using a build-in-place profile, including the case
+      --  of a function with a limited interface result, where the function
+      --  may return objects of nonlimited descendants.
+
+      if Is_Limited_View (Typ) then
+         return Ada_Version >= Ada_2005 and then not Debug_Flag_Dot_L;
+      else
+         return Debug_Flag_Dot_9;
+      end if;
+   end Is_Build_In_Place_Result_Type;
+
    --------------------------------
    -- Is_Build_In_Place_Function --
    --------------------------------
@@ -7216,20 +7247,10 @@
          --  intended to be compatible with the other language, but the build-
          --  in place machinery can ensure that the object is not copied.
 
-         if Has_Foreign_Convention (E) then
-            return False;
+         return Is_Build_In_Place_Result_Type (Etype (E))
+           and then not Has_Foreign_Convention (E)
+           and then not Debug_Flag_Dot_L;
 
-         --  In Ada 2005 all functions with an inherently limited return type
-         --  must be handled using a build-in-place profile, including the case
-         --  of a function with a limited interface result, where the function
-         --  may return objects of nonlimited descendants.
-
-         else
-            return Is_Limited_View (Etype (E))
-              and then Ada_Version >= Ada_2005
-              and then not Debug_Flag_Dot_L;
-         end if;
-
       else
          return False;
       end if;
@@ -7256,34 +7277,33 @@
       --  may end up with a call that is neither resolved to an entity, nor
       --  an indirect call.
 
-      if not Expander_Active then
+      if not Expander_Active or else Nkind (Exp_Node) /= N_Function_Call then
          return False;
       end if;
 
-      if Nkind (Exp_Node) /= N_Function_Call then
-         return False;
+      if Is_Entity_Name (Name (Exp_Node)) then
+         Function_Id := Entity (Name (Exp_Node));
 
-      else
-         if Is_Entity_Name (Name (Exp_Node)) then
-            Function_Id := Entity (Name (Exp_Node));
+      --  In the case of an explicitly dereferenced call, use the subprogram
+      --  type generated for the dereference.
 
-         --  In the case of an explicitly dereferenced call, use the subprogram
-         --  type generated for the dereference.
+      elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then
+         Function_Id := Etype (Name (Exp_Node));
 
-         elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then
-            Function_Id := Etype (Name (Exp_Node));
+      --  This may be a call to a protected function.
 
-         --  This may be a call to a protected function.
+      elsif Nkind (Name (Exp_Node)) = N_Selected_Component then
+         Function_Id := Etype (Entity (Selector_Name (Name (Exp_Node))));
 
-         elsif Nkind (Name (Exp_Node)) = N_Selected_Component then
-            Function_Id := Etype (Entity (Selector_Name (Name (Exp_Node))));
+      else
+         raise Program_Error;
+      end if;
 
-         else
-            raise Program_Error;
-         end if;
-
-         return Is_Build_In_Place_Function (Function_Id);
-      end if;
+      declare
+         Result : constant Boolean := Is_Build_In_Place_Function (Function_Id);
+      begin
+         return Result;
+      end;
    end Is_Build_In_Place_Function_Call;
 
    -----------------------
@@ -7693,16 +7713,9 @@
          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 allocator context,
-      --  but we add the protection as a defensive measure.
-
-      if Is_Expanded_Build_In_Place_Call (Func_Call) then
-         return;
-      end if;
-
       --  Mark the call as processed as a build-in-place call
 
+      pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call));
       Set_Is_Expanded_Build_In_Place_Call (Func_Call);
 
       Loc := Sloc (Function_Call);
@@ -7727,6 +7740,8 @@
 
       Return_Obj_Access := Make_Temporary (Loc, 'R');
       Set_Etype (Return_Obj_Access, Acc_Type);
+      Set_Can_Never_Be_Null (Acc_Type, False);
+      --  It gets initialized to null, so we can't have that.
 
       --  When the result subtype is constrained, the return object is
       --  allocated on the caller side, and access to it is passed to the
@@ -7738,7 +7753,6 @@
       --  the characteristics of the full view.
 
       if Is_Constrained (Underlying_Type (Result_Subt)) then
-
          --  Replace the initialized allocator of form "new T'(Func (...))"
          --  with an uninitialized allocator of form "new T", where T is the
          --  result subtype of the called function. The call to the function
@@ -8051,7 +8065,7 @@
       Lhs          : constant Node_Id := Name (Assign);
       Func_Call    : constant Node_Id := Unqual_Conv (Function_Call);
       Func_Id      : Entity_Id;
-      Loc          : Source_Ptr;
+      Loc          : constant Source_Ptr := Sloc (Function_Call);
       Obj_Decl     : Node_Id;
       Obj_Id       : Entity_Id;
       Ptr_Typ      : Entity_Id;
@@ -8060,20 +8074,11 @@
       Result_Subt  : Entity_Id;
 
    begin
-      --  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.
-
-      if Is_Expanded_Build_In_Place_Call (Func_Call) then
-         return;
-      end if;
-
       --  Mark the call as processed as a build-in-place call
 
+      pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call));
       Set_Is_Expanded_Build_In_Place_Call (Func_Call);
 
-      Loc := Sloc (Function_Call);
-
       if Is_Entity_Name (Name (Func_Call)) then
          Func_Id := Entity (Name (Func_Call));
 
@@ -8131,6 +8136,13 @@
 
       New_Expr := Make_Reference (Loc, Relocate_Node (Func_Call));
 
+      --  Add a conversion if it's the wrong type
+
+      if Etype (New_Expr) /= Ptr_Typ then
+         New_Expr := Make_Unchecked_Type_Conversion (Loc,
+           New_Occurrence_Of (Ptr_Typ, Loc), New_Expr);
+      end if;
+
       Obj_Id := Make_Temporary (Loc, 'R', New_Expr);
       Set_Etype (Obj_Id, Ptr_Typ);
       Set_Is_Known_Non_Null (Obj_Id);
@@ -8165,6 +8177,7 @@
       Func_Call       : constant Node_Id := Unqual_Conv (Function_Call);
       Function_Id     : Entity_Id;
       Pool_Actual     : Node_Id;
+      Designated_Type : Entity_Id;
       Ptr_Typ         : Entity_Id;
       Ptr_Typ_Decl    : Node_Id;
       Pass_Caller_Acc : Boolean := False;
@@ -8172,16 +8185,9 @@
       Result_Subt     : Entity_Id;
 
    begin
-      --  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.
-
-      if Is_Expanded_Build_In_Place_Call (Func_Call) then
-         return;
-      end if;
-
       --  Mark the call as processed as a build-in-place call
 
+      pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call));
       Set_Is_Expanded_Build_In_Place_Call (Func_Call);
 
       if Is_Entity_Name (Name (Func_Call)) then
@@ -8208,6 +8214,15 @@
          --  access type must be declared before we establish a transient
          --  scope, so that it receives the proper accessibility level.
 
+         if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl)))
+           and then not Is_Interface (Etype (Defining_Identifier (Obj_Decl)))
+           and then not Is_Class_Wide_Type (Etype (Function_Call))
+         then
+            Designated_Type := Etype (Defining_Identifier (Obj_Decl));
+         else
+            Designated_Type := Etype (Function_Call);
+         end if;
+
          Ptr_Typ := Make_Temporary (Loc, 'A');
          Ptr_Typ_Decl :=
            Make_Full_Type_Declaration (Loc,
@@ -8216,7 +8231,7 @@
                Make_Access_To_Object_Definition (Loc,
                  All_Present        => True,
                  Subtype_Indication =>
-                   New_Occurrence_Of (Etype (Function_Call), Loc)));
+                   New_Occurrence_Of (Designated_Type, Loc)));
 
          --  The access type and its accompanying object must be inserted after
          --  the object declaration in the constrained case, so that the
@@ -8238,15 +8253,10 @@
 
          --  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.
+         --  freezing by itself. It's not an itype, but it needs to be frozen
+         --  inside the current subprogram (see Freeze_Outside in freeze.adb).
 
-         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;
+         Freeze_Itype (Ptr_Typ, Ptr_Typ_Decl);
 
          --  If the object is a return object of an enclosing build-in-place
          --  function, then the implicit build-in-place parameters of the
@@ -8424,13 +8434,25 @@
          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)));
+         if Nkind (Function_Call) = N_Type_Conversion then
+            Res_Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Def_Id,
+                Constant_Present    => True,
+                Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc),
+                Expression          =>
+                Make_Unchecked_Type_Conversion (Loc,
+                   New_Occurrence_Of (Ptr_Typ, Loc),
+                   Make_Reference (Loc, Relocate_Node (Func_Call))));
+         else
+            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)));
+         end if;
 
          Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl);
 
@@ -8475,7 +8497,8 @@
             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),
+                Subtype_Mark =>
+                  New_Occurrence_Of (Designated_Type, Obj_Loc),
                 Name => Call_Deref));
 
             Set_Renamed_Object (Defining_Identifier (Obj_Decl), Call_Deref);
@@ -8495,18 +8518,6 @@
               (Obj_Decl, Original_Node (Obj_Decl));
          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
-      --  object will be class-wide without an explicit initialization and
-      --  won't be allocated properly by the back end. It seems unclean to make
-      --  such a revision to the type at this point, and we should try to
-      --  improve this treatment when build-in-place functions with class-wide
-      --  results are implemented. ???
-
-      if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl))) then
-         Set_Etype (Defining_Identifier (Obj_Decl), Result_Subt);
-      end if;
    end Make_Build_In_Place_Call_In_Object_Declaration;
 
    -------------------------------------------------
@@ -9225,6 +9236,11 @@
    --  Start of processing for Unqual_BIP_Iface_Function_Call
 
    begin
+      if Nkind (Expr) = N_Identifier and then No (Entity (Expr)) then
+         --  Can happen for X'Elab_Spec in the binder-generated file.
+         return Empty;
+      end if;
+
       return Unqual_BIP_Function_Call (Expr);
    end Unqual_BIP_Iface_Function_Call;
 
Index: exp_ch6.ads
===================================================================
--- exp_ch6.ads	(revision 253283)
+++ exp_ch6.ads	(working copy)
@@ -117,25 +117,30 @@
    --  The returned node is the root of the procedure body which will replace
    --  the original function body, which is not needed for the C program.
 
+   function Is_Build_In_Place_Result_Type (Typ : Entity_Id) return Boolean;
+   --  Ada 2005 (AI-318-02): Returns True if functions returning the type use
+   --  build-in-place protocols. For inherently limited types, this must be
+   --  True in >= Ada 2005, and must be False in Ada 95. For other types, it
+   --  can be True or False, and the decision should be based on efficiency,
+   --  and should be the same for all language versions, so that mixed-dialect
+   --  programs will work.
+   --
+   --  For inherently limited types in Ada 2005, True means that calls will
+   --  actually be build-in-place in all cases. For other types, build-in-place
+   --  will be used when possible, but we need to make a copy at the call site
+   --  in some cases, notably assignment statements.
+
    function Is_Build_In_Place_Function (E : Entity_Id) return Boolean;
    --  Ada 2005 (AI-318-02): Returns True if E denotes a function, generic
-   --  function, or access-to-function type whose result must be built in
-   --  place; otherwise returns False. For Ada 2005, this is currently
-   --  restricted to the set of functions whose result subtype is an inherently
-   --  limited type. In Ada 95, this must be False for inherently limited
-   --  result types (but currently returns False for all Ada 95 functions).
-   --  Eventually we plan to support build-in-place for nonlimited types.
-   --  Build-in-place is usually more efficient for large things, and less
-   --  efficient for small things. However, we never use build-in-place if the
-   --  convention is other than Ada, because that would disturb mixed-language
-   --  programs. Note that for the non-inherently-limited cases, we must make
-   --  the same decision for Ada 95 and 2005, so that mixed-dialect programs
-   --  will work.
+   --  function, or access-to-function type for which
+   --  Is_Build_In_Place_Result_Type is True. However, we never use
+   --  build-in-place if the convention is other than Ada, because that would
+   --  disturb mixed-language programs.
 
    function Is_Build_In_Place_Function_Call (N : Node_Id) return Boolean;
    --  Ada 2005 (AI-318-02): Returns True if N denotes a call to a function
-   --  that requires handling as a build-in-place call or is a qualified
-   --  expression applied to such a call; otherwise returns False.
+   --  that requires handling as a build-in-place call (possibly qualified or
+   --  converted).
 
    function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
    --  Predicate to recognize stubbed procedures and null procedures, which
@@ -212,7 +217,7 @@
      (Obj_Decl      : Node_Id;
       Function_Call : Node_Id);
    --  Ada 2005 (AI-318-02): Handle a call to a build-in-place function that
-   --  occurs as the expression initializing an object declaration by passsing
+   --  occurs as the expression initializing an object declaration by passing
    --  access to the declared object as an additional parameter of the function
    --  call. Function_Call must denote an expression containing a BIP function
    --  call and an enclosing call to Ada.Tags.Displace to displace the pointer
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 253283)
+++ exp_ch7.adb	(working copy)
@@ -4057,7 +4057,7 @@
 
    --  This procedure is called each time a transient block has to be inserted
    --  that is to say for each call to a function with unconstrained or tagged
-   --  result. It creates a new scope on the stack scope in order to enclose
+   --  result. It creates a new scope on the scope stack in order to enclose
    --  all transient variables generated.
 
    procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean) is
Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 253283)
+++ exp_util.adb	(working copy)
@@ -649,7 +649,11 @@
       --  Do not process allocations on / deallocations from the secondary
       --  stack.
 
-      elsif Is_RTE (Pool_Id, RE_SS_Pool) then
+      elsif Is_RTE (Pool_Id, RE_SS_Pool)
+        or else
+          (Nkind (Expr) = N_Allocator
+             and then Is_RTE (Storage_Pool (Expr), RE_SS_Pool))
+      then
          return;
 
       --  Optimize the case where we are using the default Global_Pool_Object,
@@ -7857,6 +7861,8 @@
             Call := Prefix (Call);
          end if;
 
+         Call := Unqual_Conv (Call);
+
          if Is_Build_In_Place_Function_Call (Call) then
             declare
                Access_Nam : Name_Id := No_Name;
@@ -8679,9 +8685,7 @@
 
          Param := First (Parameter_Associations (Call));
          while Present (Param) loop
-            if Nkind (Param) = N_Parameter_Association
-              and then Nkind (Selector_Name (Param)) = N_Identifier
-            then
+            if Nkind (Param) = N_Parameter_Association then
                Formal := Selector_Name (Param);
                Actual := Explicit_Actual_Parameter (Param);
 
Index: exp_ch8.adb
===================================================================
--- exp_ch8.adb	(revision 253283)
+++ exp_ch8.adb	(working copy)
@@ -176,23 +176,16 @@
 
       --  Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
       --  place function, then a temporary return object needs to be created
-      --  and access to it must be passed to the function. Currently we limit
-      --  such functions to those with inherently limited result subtypes, but
-      --  eventually we plan to expand the functions that are treated as
-      --  build-in-place to include other composite result types.
+      --  and access to it must be passed to the function.
 
-      if Ada_Version >= Ada_2005
-        and then Is_Build_In_Place_Function_Call (Nam)
-      then
+      if Is_Build_In_Place_Function_Call (Nam) then
          Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
 
       --  Ada 2005 (AI-318-02): Specialization of previous case for renaming
       --  containing build-in-place function calls whose returned object covers
       --  interface types.
 
-      elsif Ada_Version >= Ada_2005
-        and then Present (Unqual_BIP_Iface_Function_Call (Nam))
-      then
+      elsif Present (Unqual_BIP_Iface_Function_Call (Nam)) then
          Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Nam);
       end if;
 
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 253283)
+++ snames.ads-tmpl	(working copy)
@@ -328,7 +328,7 @@
 
    --  Operator Symbol entries. The actual names have an upper case O at the
    --  start in place of the Op_ prefix (e.g. the actual name that corresponds
-   --  to Name_Op_Abs is "Oabs".
+   --  to Name_Op_Abs is "Oabs").
 
    First_Operator_Name                 : constant Name_Id := N + $;
    Name_Op_Abs                         : constant Name_Id := N + $; -- "abs"
Index: exp_attr.adb
===================================================================
--- exp_attr.adb	(revision 253283)
+++ exp_attr.adb	(working copy)
@@ -1753,23 +1753,16 @@
 
       --  Ada 2005 (AI-318-02): If attribute prefix is a call to a build-in-
       --  place function, then a temporary return object needs to be created
-      --  and access to it must be passed to the function. Currently we limit
-      --  such functions to those with inherently limited result subtypes, but
-      --  eventually we plan to expand the functions that are treated as
-      --  build-in-place to include other composite result types.
+      --  and access to it must be passed to the function.
 
-      if Ada_Version >= Ada_2005
-        and then Is_Build_In_Place_Function_Call (Pref)
-      then
+      if Is_Build_In_Place_Function_Call (Pref) then
          Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
 
       --  Ada 2005 (AI-318-02): Specialization of the previous case for prefix
       --  containing build-in-place function calls whose returned object covers
       --  interface types.
 
-      elsif Ada_Version >= Ada_2005
-        and then Present (Unqual_BIP_Iface_Function_Call (Pref))
-      then
+      elsif Present (Unqual_BIP_Iface_Function_Call (Pref)) then
          Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Pref);
       end if;
 
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 253283)
+++ sinfo.ads	(working copy)
@@ -1372,9 +1372,9 @@
    --    up. For nested aggregates the expansion is delayed until the enclosing
    --    aggregate itself is expanded, e.g. in the context of a declaration. To
    --    delay it we set this flag. This is done to avoid creating a temporary
-   --    for each level of a nested aggregates, and also to prevent the
+   --    for each level of a nested aggregate, and also to prevent the
    --    premature generation of constraint checks. This is also a requirement
-   --    if we want to generate the proper attachment to the internal
+   --    if we want to generate the proper attachment to the internal????
    --    finalization lists (for record with controlled components). Top down
    --    expansion of aggregates is also used for in-place array aggregate
    --    assignment or initialization. When the full context is known, the
@@ -2917,7 +2917,7 @@
       --  case the front end must generate an extra temporary and initialize
       --  this temporary as required (the temporary itself is not atomic).
 
-      --  Note: there is not node kind for object definition. Instead, the
+      --  Note: there is no node kind for object definition. Instead, the
       --  corresponding field holds a subtype indication, an array type
       --  definition, or (Ada 2005, AI-406) an access definition.
 
Index: exp_disp.adb
===================================================================
--- exp_disp.adb	(revision 253283)
+++ exp_disp.adb	(working copy)
@@ -1640,9 +1640,7 @@
                --  interface conversion, so if this is a BIP call then we need
                --  to handle it now.
 
-               if Ada_Version >= Ada_2005
-                 and then Is_Build_In_Place_Function_Call (Actual)
-               then
+               if Is_Build_In_Place_Function_Call (Actual) then
                   Make_Build_In_Place_Call_In_Anonymous_Context (Actual);
                end if;
 
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb	(revision 253283)
+++ exp_ch3.adb	(working copy)
@@ -6299,9 +6299,7 @@
          --  plan to expand the allowed forms of functions that are treated as
          --  build-in-place.
 
-         elsif Ada_Version >= Ada_2005
-           and then Is_Build_In_Place_Function_Call (Expr_Q)
-         then
+         elsif Is_Build_In_Place_Function_Call (Expr_Q) then
             Make_Build_In_Place_Call_In_Object_Declaration (N, Expr_Q);
 
             --  The previous call expands the expression initializing the
@@ -6317,9 +6315,7 @@
          --  in-place object to reference the secondary dispatch table of a
          --  covered interface type.
 
-         elsif Ada_Version >= Ada_2005
-           and then Present (Unqual_BIP_Iface_Function_Call (Expr_Q))
-         then
+         elsif Present (Unqual_BIP_Iface_Function_Call (Expr_Q)) then
             Make_Build_In_Place_Iface_Call_In_Object_Declaration (N, Expr_Q);
 
             --  The previous call expands the expression initializing the
@@ -6617,13 +6613,19 @@
             --  the target is adjusted after the copy and attached to the
             --  finalization list. However, no adjustment is done in the case
             --  where the object was initialized by a call to a function whose
-            --  result is built in place, since no copy occurred. (Eventually
-            --  we plan to support in-place function results for some cases
-            --  of nonlimited types. ???) Similarly, no adjustment is required
-            --  if we are going to rewrite the object declaration into a
-            --  renaming declaration.
+            --  result is built in place, since no copy occurred. Similarly, no
+            --  adjustment is required if we are going to rewrite the object
+            --  declaration into a renaming declaration.
 
-            if Needs_Finalization (Typ)
+            if Is_Build_In_Place_Result_Type (Typ)
+              and then Nkind (Parent (N)) = N_Extended_Return_Statement
+              and then not Is_Definite_Subtype
+                (Etype (Return_Applies_To
+                         (Return_Statement_Entity (Parent (N)))))
+            then
+               null;
+
+            elsif Needs_Finalization (Typ)
               and then not Is_Limited_View (Typ)
               and then not Rewrite_As_Renaming
             then
@@ -6755,9 +6757,9 @@
             end if;
          end if;
 
-         --  Cases where the back end cannot handle the initialization directly
-         --  In such cases, we expand an assignment that will be appropriately
-         --  handled by Expand_N_Assignment_Statement.
+         --  Cases where the back end cannot handle the initialization
+         --  directly. In such cases, we expand an assignment that will
+         --  be appropriately handled by Expand_N_Assignment_Statement.
 
          --  The exclusion of the unconstrained case is wrong, but for now it
          --  is too much trouble ???
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 253283)
+++ exp_ch4.adb	(working copy)
@@ -793,14 +793,9 @@
 
          --  Ada 2005 (AI-318-02): If the initialization expression is a call
          --  to a build-in-place function, then access to the allocated object
-         --  must be passed to the function. Currently we limit such functions
-         --  to those with constrained limited result subtypes, but eventually
-         --  we plan to expand the allowed forms of functions that are treated
-         --  as build-in-place.
+         --  must be passed to the function.
 
-         if Ada_Version >= Ada_2005
-           and then Is_Build_In_Place_Function_Call (Exp)
-         then
+         if Is_Build_In_Place_Function_Call (Exp) then
             Make_Build_In_Place_Call_In_Allocator (N, Exp);
             Apply_Accessibility_Check (N, Built_In_Place => True);
             return;
@@ -812,9 +807,7 @@
          --  in-place object to reference the secondary dispatch table of a
          --  covered interface type.
 
-         elsif Ada_Version >= Ada_2005
-           and then Present (Unqual_BIP_Iface_Function_Call (Exp))
-         then
+         elsif Present (Unqual_BIP_Iface_Function_Call (Exp)) then
             Make_Build_In_Place_Iface_Call_In_Allocator (N, Exp);
             Apply_Accessibility_Check (N, Built_In_Place => True);
             return;
@@ -1223,14 +1216,9 @@
 
          --  Ada 2005 (AI-318-02): If the initialization expression is a call
          --  to a build-in-place function, then access to the allocated object
-         --  must be passed to the function. Currently we limit such functions
-         --  to those with constrained limited result subtypes, but eventually
-         --  we plan to expand the allowed forms of functions that are treated
-         --  as build-in-place.
+         --  must be passed to the function.
 
-         if Ada_Version >= Ada_2005
-           and then Is_Build_In_Place_Function_Call (Exp)
-         then
+         if Is_Build_In_Place_Function_Call (Exp) then
             Make_Build_In_Place_Call_In_Allocator (N, Exp);
          end if;
       end if;
@@ -6572,18 +6560,14 @@
       --  Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
       --  function, then additional actuals must be passed.
 
-      if Ada_Version >= Ada_2005
-        and then Is_Build_In_Place_Function_Call (P)
-      then
+      if Is_Build_In_Place_Function_Call (P) then
          Make_Build_In_Place_Call_In_Anonymous_Context (P);
 
       --  Ada 2005 (AI-318-02): Specialization of the previous case for prefix
       --  containing build-in-place function calls whose returned object covers
       --  interface types.
 
-      elsif Ada_Version >= Ada_2005
-        and then Present (Unqual_BIP_Iface_Function_Call (P))
-      then
+      elsif Present (Unqual_BIP_Iface_Function_Call (P)) then
          Make_Build_In_Place_Iface_Call_In_Anonymous_Context (P);
       end if;
 
@@ -10221,18 +10205,14 @@
       --  Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
       --  function, then additional actuals must be passed.
 
-      if Ada_Version >= Ada_2005
-        and then Is_Build_In_Place_Function_Call (P)
-      then
+      if Is_Build_In_Place_Function_Call (P) then
          Make_Build_In_Place_Call_In_Anonymous_Context (P);
 
       --  Ada 2005 (AI-318-02): Specialization of the previous case for prefix
       --  containing build-in-place function calls whose returned object covers
       --  interface types.
 
-      elsif Ada_Version >= Ada_2005
-        and then Present (Unqual_BIP_Iface_Function_Call (P))
-      then
+      elsif Present (Unqual_BIP_Iface_Function_Call (P)) then
          Make_Build_In_Place_Iface_Call_In_Anonymous_Context (P);
       end if;
 
@@ -10587,18 +10567,14 @@
       --  Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
       --  function, then additional actuals must be passed.
 
-      if Ada_Version >= Ada_2005
-        and then Is_Build_In_Place_Function_Call (Pref)
-      then
+      if Is_Build_In_Place_Function_Call (Pref) then
          Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
 
       --  Ada 2005 (AI-318-02): Specialization of the previous case for prefix
       --  containing build-in-place function calls whose returned object covers
       --  interface types.
 
-      elsif Ada_Version >= Ada_2005
-        and then Present (Unqual_BIP_Iface_Function_Call (Pref))
-      then
+      elsif Present (Unqual_BIP_Iface_Function_Call (Pref)) then
          Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Pref);
       end if;
 
Index: debug.adb
===================================================================
--- debug.adb	(revision 253283)
+++ debug.adb	(working copy)
@@ -163,7 +163,7 @@
    --  d.6  Do not avoid declaring unreferenced types in C code
    --  d.7
    --  d.8
-   --  d.9
+   --  d.9  Enable build-in-place for nonlimited types
 
    --  Debug flags for binder (GNATBIND)
 
@@ -820,6 +820,9 @@
    --       referenced by the generated C code. This debug flag restores the
    --       output of all the types.
 
+   --  d.9  Enable build-in-place for function calls returning some nonlimited
+   --       types.
+
    ------------------------------------------
    -- Documentation for Binder Debug Flags --
    ------------------------------------------

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2017-09-29 13:49 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-09-29 13:49 [Ada] Build in place for nonlimited types Pierre-Marie de Rodat

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).