+2017-10-20 Bob Duff <duff@adacore.com>
+
+ * sinfo.ads, sinfo.adb (Alloc_For_BIP_Return): New flag to indicate
+ that an allocator came from a b-i-p return statement.
+ * exp_ch4.adb (Expand_Allocator_Expression): Avoid adjusting the return
+ object of a nonlimited build-in-place function call.
+ * exp_ch6.adb (Expand_N_Extended_Return_Statement): Set the
+ Alloc_For_BIP_Return flag on generated allocators.
+ * sem_ch5.adb (Analyze_Assignment): Move Assert to where it can't fail.
+ If the N_Assignment_Statement has been transformed into something else,
+ then Should_Transform_BIP_Assignment won't work.
+ * exp_ch3.adb (Expand_N_Object_Declaration): A previous revision said,
+ "Remove Adjust if we're building the return object of an extended
+ return statement in place." Back out that part of the change, because
+ the Alloc_For_BIP_Return flag is now used for that.
+
2017-10-19 Bob Duff <duff@adacore.com>
* exp_ch6.adb (Is_Build_In_Place_Result_Type): Fix silly bug -- "Typ"
-- adjustment is required if we are going to rewrite the object
-- declaration into a renaming declaration.
- 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)
+ if Needs_Finalization (Typ)
and then not Is_Limited_View (Typ)
and then not Rewrite_As_Renaming
then
-- object can be limited but not inherently limited if this allocator
-- came from a return statement (we're allocating the result on the
-- secondary stack). In that case, the object will be moved, so we do
- -- want to Adjust.
+ -- want to Adjust. However, if it's a nonlimited build-in-place
+ -- function call, Adjust is not wanted.
if Needs_Finalization (DesigT)
and then Needs_Finalization (T)
and then not Aggr_In_Place
and then not Is_Limited_View (T)
+ and then not Alloc_For_BIP_Return (N)
+ and then not Is_Build_In_Place_Function_Call (Expression (N))
then
-- An unchecked conversion is needed in the classwide case because
-- the designated type can be an ancestor of the subtype mark of
Set_No_Initialization (Heap_Allocator);
end if;
+ -- Set the flag indicating that the allocator came from
+ -- a build-in-place return statement, so we can avoid
+ -- adjusting the allocated object. Note that this flag
+ -- will be inherited by the copies made below.
+
+ Set_Alloc_For_BIP_Return (Heap_Allocator);
+
-- The Pool_Allocator is just like the Heap_Allocator,
-- except we set Storage_Pool and Procedure_To_Call so
-- it will use the user-defined storage pool.
Pool_Allocator := New_Copy_Tree (Heap_Allocator);
+ pragma Assert (Alloc_For_BIP_Return (Pool_Allocator));
-- Do not generate the renaming of the build-in-place
-- pool parameter on ZFP because the parameter is not
else
SS_Allocator := New_Copy_Tree (Heap_Allocator);
+ pragma Assert (Alloc_For_BIP_Return (SS_Allocator));
-- The heap and pool allocators are marked as
-- Comes_From_Source since they correspond to an
-- the context of the assignment statement. Restore the expander mode
-- now so that assignment statement can be properly expanded.
- if Nkind (N) = N_Assignment_Statement and then Has_Target_Names (N) then
- Expander_Mode_Restore;
- Full_Analysis := Save_Full_Analysis;
- end if;
+ if Nkind (N) = N_Assignment_Statement then
+ if Has_Target_Names (N) then
+ Expander_Mode_Restore;
+ Full_Analysis := Save_Full_Analysis;
+ end if;
- pragma Assert (not Should_Transform_BIP_Assignment (Typ => T1));
+ pragma Assert (not Should_Transform_BIP_Assignment (Typ => T1));
+ end if;
end Analyze_Assignment;
-----------------------------
return Flag4 (N);
end Aliased_Present;
+ function Alloc_For_BIP_Return
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Allocator);
+ return Flag1 (N);
+ end Alloc_For_BIP_Return;
+
function All_Others
(N : Node_Id) return Boolean is
begin
Set_Flag4 (N, Val);
end Set_Aliased_Present;
+ procedure Set_Alloc_For_BIP_Return
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Allocator);
+ Set_Flag1 (N, Val);
+ end Set_Alloc_For_BIP_Return;
+
procedure Set_All_Others
(N : Node_Id; Val : Boolean := True) is
begin
-- known at compile time, this field points to an N_Range node with those
-- bounds. Otherwise Empty.
+ -- Alloc_For_BIP_Return (Flag1-Sem)
+ -- Present in N_Allocator nodes. True if the allocator is one of those
+ -- generated for a build-in-place return statement.
+
-- All_Others (Flag11-Sem)
-- Present in an N_Others_Choice node. This flag is set for an others
-- exception where all exceptions are to be caught, even those that are
-- Subpool_Handle_Name (Node4) (set to Empty if not present)
-- Storage_Pool (Node1-Sem)
-- Procedure_To_Call (Node2-Sem)
+ -- Alloc_For_BIP_Return (Flag1-Sem)
-- Null_Exclusion_Present (Flag11)
-- No_Initialization (Flag13-Sem)
-- Is_Static_Coextension (Flag14-Sem)
-- The required semantics is that the set of actions is executed in
-- the order in which it appears, as though they appeared by themselves
- -- in the enclosing list of declarations of statements. Unlike what
+ -- in the enclosing list of declarations or statements. Unlike what
-- happens when using an N_Block_Statement, no new scope is introduced.
-- Note: for the time being, this is used only as a transient
function Aliased_Present
(N : Node_Id) return Boolean; -- Flag4
+ function Alloc_For_BIP_Return
+ (N : Node_Id) return Boolean; -- Flag1
+
function All_Others
(N : Node_Id) return Boolean; -- Flag11
procedure Set_Aliased_Present
(N : Node_Id; Val : Boolean := True); -- Flag4
+ procedure Set_Alloc_For_BIP_Return
+ (N : Node_Id; Val : Boolean := True); -- Flag1
+
procedure Set_All_Others
(N : Node_Id; Val : Boolean := True); -- Flag11
pragma Inline (Address_Warning_Posted);
pragma Inline (Aggregate_Bounds);
pragma Inline (Aliased_Present);
+ pragma Inline (Alloc_For_BIP_Return);
pragma Inline (All_Others);
pragma Inline (All_Present);
pragma Inline (Alternatives);
pragma Inline (Set_Address_Warning_Posted);
pragma Inline (Set_Aggregate_Bounds);
pragma Inline (Set_Aliased_Present);
+ pragma Inline (Set_Alloc_For_BIP_Return);
pragma Inline (Set_All_Others);
pragma Inline (Set_All_Present);
pragma Inline (Set_Alternatives);
projects / gcc.git / commitdiff