Commit 937e9676 by Arnaud Charlet

[multiple changes]

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

	* einfo.adb Flag252 is now used as Is_Finalized_Transient. Flag295
	is now used as Is_Ignored_Transient.
	(Is_Finalized_Transient): New routine.
	(Is_Ignored_Transient): New routine.
	(Is_Processed_Transient): Removed.
	(Set_Is_Finalized_Transient): New routine.
	(Set_Is_Ignored_Transient): New routine.
	(Set_Is_Processed_Transient): Removed.
	(Write_Entity_Flags): Output Flag252 and Flag295.
	* einfo.ads: New attributes Is_Finalized_Transient
	and Is_Ignored_Transient along with occurrences in
	entities. Remove attribute Is_Processed_Transient.
	(Is_Finalized_Transient): New routine along with pragma Inline.
	(Is_Ignored_Transient): New routine along with pragma Inline.
	(Is_Processed_Transient): Removed along with pragma Inline.
	(Set_Is_Finalized_Transient): New routine along with pragma Inline.
	(Set_Is_Ignored_Transient): New routine along with pragma Inline.
	(Set_Is_Processed_Transient): Removed along with pragma Inline.
	* exp_aggr.adb Add with and use clauses for Exp_Ch11 and Inline.
	(Build_Record_Aggr_Code): Change the handling
	of controlled record components.
	(Ctrl_Init_Expression): Removed.
	(Gen_Assign): Add new formal parameter In_Loop
	along with comment on usage.  Remove local variables Stmt and
	Stmt_Expr. Change the handling of controlled array components.
	(Gen_Loop): Update the call to Gen_Assign.
	(Gen_While): Update the call to Gen_Assign.
	(Initialize_Array_Component): New routine.
	(Initialize_Ctrl_Array_Component): New routine.
	(Initialize_Ctrl_Record_Component): New routine.
	(Initialize_Record_Component): New routine.
	(Process_Transient_Component): New routine.
	(Process_Transient_Component_Completion): New routine.
	* exp_ch4.adb (Process_Transient_In_Expression): New routine.
	(Process_Transient_Object): Removed. Replace all existing calls
	to this routine with calls to Process_Transient_In_Expression.
	* exp_ch6.adb (Expand_Ctrl_Function_Call): Remove local constant
	Is_Elem_Ref. Update the comment on ignoring transients.
	* exp_ch7.adb (Process_Declarations): Do not process ignored
	or finalized transient objects.
	(Process_Transient_In_Scope): New routine.
	(Process_Transients_In_Scope): New routine.
	(Process_Transient_Objects): Removed. Replace all existing calls
	to this routine with calls to Process_Transients_In_Scope.
	* exp_util.adb (Build_Transient_Object_Statements): New routine.
	(Is_Finalizable_Transient): Do not consider a transient object
	which has been finalized.
	(Requires_Cleanup_Actions): Do not consider ignored or finalized
	transient objects.
	* exp_util.ads (Build_Transient_Object_Statements): New routine.
	* sem_aggr.adb: Major code clean up.
	* sem_res.adb: Update documentation.

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

	* sem_ch3.adb (Analyze_Subtype_Declaration): For generated
	subtypes, such as actual subtypes of unconstrained formals,
	inherit predicate functions, if any, from the parent type rather
	than creating redundant new ones.

From-SVN: r238044
parent 75e4e36d
2016-07-06 Hristian Kirtchev <kirtchev@adacore.com> 2016-07-06 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb Flag252 is now used as Is_Finalized_Transient. Flag295
is now used as Is_Ignored_Transient.
(Is_Finalized_Transient): New routine.
(Is_Ignored_Transient): New routine.
(Is_Processed_Transient): Removed.
(Set_Is_Finalized_Transient): New routine.
(Set_Is_Ignored_Transient): New routine.
(Set_Is_Processed_Transient): Removed.
(Write_Entity_Flags): Output Flag252 and Flag295.
* einfo.ads: New attributes Is_Finalized_Transient
and Is_Ignored_Transient along with occurrences in
entities. Remove attribute Is_Processed_Transient.
(Is_Finalized_Transient): New routine along with pragma Inline.
(Is_Ignored_Transient): New routine along with pragma Inline.
(Is_Processed_Transient): Removed along with pragma Inline.
(Set_Is_Finalized_Transient): New routine along with pragma Inline.
(Set_Is_Ignored_Transient): New routine along with pragma Inline.
(Set_Is_Processed_Transient): Removed along with pragma Inline.
* exp_aggr.adb Add with and use clauses for Exp_Ch11 and Inline.
(Build_Record_Aggr_Code): Change the handling
of controlled record components.
(Ctrl_Init_Expression): Removed.
(Gen_Assign): Add new formal parameter In_Loop
along with comment on usage. Remove local variables Stmt and
Stmt_Expr. Change the handling of controlled array components.
(Gen_Loop): Update the call to Gen_Assign.
(Gen_While): Update the call to Gen_Assign.
(Initialize_Array_Component): New routine.
(Initialize_Ctrl_Array_Component): New routine.
(Initialize_Ctrl_Record_Component): New routine.
(Initialize_Record_Component): New routine.
(Process_Transient_Component): New routine.
(Process_Transient_Component_Completion): New routine.
* exp_ch4.adb (Process_Transient_In_Expression): New routine.
(Process_Transient_Object): Removed. Replace all existing calls
to this routine with calls to Process_Transient_In_Expression.
* exp_ch6.adb (Expand_Ctrl_Function_Call): Remove local constant
Is_Elem_Ref. Update the comment on ignoring transients.
* exp_ch7.adb (Process_Declarations): Do not process ignored
or finalized transient objects.
(Process_Transient_In_Scope): New routine.
(Process_Transients_In_Scope): New routine.
(Process_Transient_Objects): Removed. Replace all existing calls
to this routine with calls to Process_Transients_In_Scope.
* exp_util.adb (Build_Transient_Object_Statements): New routine.
(Is_Finalizable_Transient): Do not consider a transient object
which has been finalized.
(Requires_Cleanup_Actions): Do not consider ignored or finalized
transient objects.
* exp_util.ads (Build_Transient_Object_Statements): New routine.
* sem_aggr.adb: Major code clean up.
* sem_res.adb: Update documentation.
2016-07-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Analyze_Subtype_Declaration): For generated
subtypes, such as actual subtypes of unconstrained formals,
inherit predicate functions, if any, from the parent type rather
than creating redundant new ones.
2016-07-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb, sem_attr.adb, sem_ch13.adb: Minor reformatting. * exp_attr.adb, sem_attr.adb, sem_ch13.adb: Minor reformatting.
2016-07-06 Arnaud Charlet <charlet@adacore.com> 2016-07-06 Arnaud Charlet <charlet@adacore.com>
......
...@@ -561,7 +561,7 @@ package body Einfo is ...@@ -561,7 +561,7 @@ package body Einfo is
-- Has_Predicates Flag250 -- Has_Predicates Flag250
-- Has_Implicit_Dereference Flag251 -- Has_Implicit_Dereference Flag251
-- Is_Processed_Transient Flag252 -- Is_Finalized_Transient Flag252
-- Disable_Controlled Flag253 -- Disable_Controlled Flag253
-- Is_Implementation_Defined Flag254 -- Is_Implementation_Defined Flag254
-- Is_Predicate_Function Flag255 -- Is_Predicate_Function Flag255
...@@ -609,8 +609,8 @@ package body Einfo is ...@@ -609,8 +609,8 @@ package body Einfo is
-- Is_Partial_Invariant_Procedure Flag292 -- Is_Partial_Invariant_Procedure Flag292
-- Is_Actual_Subtype Flag293 -- Is_Actual_Subtype Flag293
-- Has_Pragma_Unused Flag294 -- Has_Pragma_Unused Flag294
-- Is_Ignored_Transient Flag295
-- (unused) Flag295
-- (unused) Flag296 -- (unused) Flag296
-- (unused) Flag297 -- (unused) Flag297
-- (unused) Flag298 -- (unused) Flag298
...@@ -2185,6 +2185,12 @@ package body Einfo is ...@@ -2185,6 +2185,12 @@ package body Einfo is
return Flag99 (Id); return Flag99 (Id);
end Is_Exported; end Is_Exported;
function Is_Finalized_Transient (Id : E) return B is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
return Flag252 (Id);
end Is_Finalized_Transient;
function Is_First_Subtype (Id : E) return B is function Is_First_Subtype (Id : E) return B is
begin begin
return Flag70 (Id); return Flag70 (Id);
...@@ -2250,6 +2256,12 @@ package body Einfo is ...@@ -2250,6 +2256,12 @@ package body Einfo is
return Flag278 (Id); return Flag278 (Id);
end Is_Ignored_Ghost_Entity; end Is_Ignored_Ghost_Entity;
function Is_Ignored_Transient (Id : E) return B is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
return Flag295 (Id);
end Is_Ignored_Transient;
function Is_Immediately_Visible (Id : E) return B is function Is_Immediately_Visible (Id : E) return B is
begin begin
pragma Assert (Nkind (Id) in N_Entity); pragma Assert (Nkind (Id) in N_Entity);
...@@ -2466,12 +2478,6 @@ package body Einfo is ...@@ -2466,12 +2478,6 @@ package body Einfo is
return Flag245 (Id); return Flag245 (Id);
end Is_Private_Primitive; end Is_Private_Primitive;
function Is_Processed_Transient (Id : E) return B is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
return Flag252 (Id);
end Is_Processed_Transient;
function Is_Public (Id : E) return B is function Is_Public (Id : E) return B is
begin begin
pragma Assert (Nkind (Id) in N_Entity); pragma Assert (Nkind (Id) in N_Entity);
...@@ -5248,6 +5254,12 @@ package body Einfo is ...@@ -5248,6 +5254,12 @@ package body Einfo is
Set_Flag99 (Id, V); Set_Flag99 (Id, V);
end Set_Is_Exported; end Set_Is_Exported;
procedure Set_Is_Finalized_Transient (Id : E; V : B := True) is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
Set_Flag252 (Id, V);
end Set_Is_Finalized_Transient;
procedure Set_Is_First_Subtype (Id : E; V : B := True) is procedure Set_Is_First_Subtype (Id : E; V : B := True) is
begin begin
Set_Flag70 (Id, V); Set_Flag70 (Id, V);
...@@ -5329,6 +5341,12 @@ package body Einfo is ...@@ -5329,6 +5341,12 @@ package body Einfo is
Set_Flag278 (Id, V); Set_Flag278 (Id, V);
end Set_Is_Ignored_Ghost_Entity; end Set_Is_Ignored_Ghost_Entity;
procedure Set_Is_Ignored_Transient (Id : E; V : B := True) is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
Set_Flag295 (Id, V);
end Set_Is_Ignored_Transient;
procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
begin begin
pragma Assert (Nkind (Id) in N_Entity); pragma Assert (Nkind (Id) in N_Entity);
...@@ -5543,12 +5561,6 @@ package body Einfo is ...@@ -5543,12 +5561,6 @@ package body Einfo is
Set_Flag245 (Id, V); Set_Flag245 (Id, V);
end Set_Is_Private_Primitive; end Set_Is_Private_Primitive;
procedure Set_Is_Processed_Transient (Id : E; V : B := True) is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
Set_Flag252 (Id, V);
end Set_Is_Processed_Transient;
procedure Set_Is_Public (Id : E; V : B := True) is procedure Set_Is_Public (Id : E; V : B := True) is
begin begin
pragma Assert (Nkind (Id) in N_Entity); pragma Assert (Nkind (Id) in N_Entity);
...@@ -9241,6 +9253,7 @@ package body Einfo is ...@@ -9241,6 +9253,7 @@ package body Einfo is
W ("Is_Entry_Formal", Flag52 (Id)); W ("Is_Entry_Formal", Flag52 (Id));
W ("Is_Exception_Handler", Flag286 (Id)); W ("Is_Exception_Handler", Flag286 (Id));
W ("Is_Exported", Flag99 (Id)); W ("Is_Exported", Flag99 (Id));
W ("Is_Finalized_Transient", Flag252 (Id));
W ("Is_First_Subtype", Flag70 (Id)); W ("Is_First_Subtype", Flag70 (Id));
W ("Is_For_Access_Subtype", Flag118 (Id)); W ("Is_For_Access_Subtype", Flag118 (Id));
W ("Is_Formal_Subprogram", Flag111 (Id)); W ("Is_Formal_Subprogram", Flag111 (Id));
...@@ -9253,6 +9266,7 @@ package body Einfo is ...@@ -9253,6 +9266,7 @@ package body Einfo is
W ("Is_Hidden_Non_Overridden_Subpgm", Flag2 (Id)); W ("Is_Hidden_Non_Overridden_Subpgm", Flag2 (Id));
W ("Is_Hidden_Open_Scope", Flag171 (Id)); W ("Is_Hidden_Open_Scope", Flag171 (Id));
W ("Is_Ignored_Ghost_Entity", Flag278 (Id)); W ("Is_Ignored_Ghost_Entity", Flag278 (Id));
W ("Is_Ignored_Transient", Flag295 (Id));
W ("Is_Immediately_Visible", Flag7 (Id)); W ("Is_Immediately_Visible", Flag7 (Id));
W ("Is_Implementation_Defined", Flag254 (Id)); W ("Is_Implementation_Defined", Flag254 (Id));
W ("Is_Imported", Flag24 (Id)); W ("Is_Imported", Flag24 (Id));
...@@ -9292,7 +9306,6 @@ package body Einfo is ...@@ -9292,7 +9306,6 @@ package body Einfo is
W ("Is_Private_Composite", Flag107 (Id)); W ("Is_Private_Composite", Flag107 (Id));
W ("Is_Private_Descendant", Flag53 (Id)); W ("Is_Private_Descendant", Flag53 (Id));
W ("Is_Private_Primitive", Flag245 (Id)); W ("Is_Private_Primitive", Flag245 (Id));
W ("Is_Processed_Transient", Flag252 (Id));
W ("Is_Public", Flag10 (Id)); W ("Is_Public", Flag10 (Id));
W ("Is_Pure", Flag44 (Id)); W ("Is_Pure", Flag44 (Id));
W ("Is_Pure_Unit_Access_Type", Flag189 (Id)); W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
......
...@@ -535,7 +535,7 @@ package Einfo is ...@@ -535,7 +535,7 @@ package Einfo is
-- a build-in-place function call. Contains the relocated build-in-place -- a build-in-place function call. Contains the relocated build-in-place
-- call after the expansion has decoupled the call from the object. This -- call after the expansion has decoupled the call from the object. This
-- attribute is used by the finalization machinery to insert cleanup code -- attribute is used by the finalization machinery to insert cleanup code
-- for all additional transient variables found in the transient block. -- for all additional transient objects found in the transient block.
-- C_Pass_By_Copy (Flag125) [implementation base type only] -- C_Pass_By_Copy (Flag125) [implementation base type only]
-- Defined in record types. Set if a pragma Convention for the record -- Defined in record types. Set if a pragma Convention for the record
...@@ -2484,6 +2484,12 @@ package Einfo is ...@@ -2484,6 +2484,12 @@ package Einfo is
-- Applies to all entities, true for abstract states that are subject to -- Applies to all entities, true for abstract states that are subject to
-- option External. -- option External.
-- Is_Finalized_Transient (Flag252)
-- Defined in constants, loop parameters of generalized iterators, and
-- variables. Set when a transient object has been finalized by one of
-- the transient finalization mechanisms. The flag prevents the double
-- finalization of the object.
-- Is_Finalizer (synthesized) -- Is_Finalizer (synthesized)
-- Applies to all entities, true for procedures containing finalization -- Applies to all entities, true for procedures containing finalization
-- code to process local or library level objects. -- code to process local or library level objects.
...@@ -2595,6 +2601,13 @@ package Einfo is ...@@ -2595,6 +2601,13 @@ package Einfo is
-- pragma Ghost or inherit "ghostness" from an enclosing construct, and -- pragma Ghost or inherit "ghostness" from an enclosing construct, and
-- subject to Assertion_Policy Ghost => Ignore. -- subject to Assertion_Policy Ghost => Ignore.
-- Is_Ignored_Transient (Flag295)
-- Defined in constants, loop parameters of generalized iterators, and
-- variables. Set when a transient object must be processed by one of
-- the transient finalization mechanisms. Once marked, a transient is
-- intentionally ignored by the general finalization mechanism because
-- its clean up actions are context specific.
-- Is_Immediately_Visible (Flag7) -- Is_Immediately_Visible (Flag7)
-- Defined in all entities. Set if entity is immediately visible, i.e. -- Defined in all entities. Set if entity is immediately visible, i.e.
-- is defined in some currently open scope (RM 8.3(4)). -- is defined in some currently open scope (RM 8.3(4)).
...@@ -2997,13 +3010,6 @@ package Einfo is ...@@ -2997,13 +3010,6 @@ package Einfo is
-- Applies to all entities, true for private types and subtypes, -- Applies to all entities, true for private types and subtypes,
-- as well as for record with private types as subtypes. -- as well as for record with private types as subtypes.
-- Is_Processed_Transient (Flag252)
-- Defined in variables, loop parameters, and constants, including the
-- loop parameters of generalized iterators. Set when a transient object
-- needs to be finalized and has already been processed by the transient
-- scope machinery. This flag signals the general finalization mechanism
-- to ignore the transient object.
-- Is_Protected_Component (synthesized) -- Is_Protected_Component (synthesized)
-- Applicable to all entities, true if the entity denotes a private -- Applicable to all entities, true if the entity denotes a private
-- component of a protected type. -- component of a protected type.
...@@ -5786,8 +5792,9 @@ package Einfo is ...@@ -5786,8 +5792,9 @@ package Einfo is
-- Has_Volatile_Components (Flag87) -- Has_Volatile_Components (Flag87)
-- Is_Atomic (Flag85) -- Is_Atomic (Flag85)
-- Is_Eliminated (Flag124) -- Is_Eliminated (Flag124)
-- Is_Finalized_Transient (Flag252)
-- Is_Ignored_Transient (Flag295)
-- Is_Independent (Flag268) -- Is_Independent (Flag268)
-- Is_Processed_Transient (Flag252) (constants only)
-- Is_Return_Object (Flag209) -- Is_Return_Object (Flag209)
-- Is_True_Constant (Flag163) -- Is_True_Constant (Flag163)
-- Is_Uplevel_Referenced_Entity (Flag283) -- Is_Uplevel_Referenced_Entity (Flag283)
...@@ -6552,8 +6559,9 @@ package Einfo is ...@@ -6552,8 +6559,9 @@ package Einfo is
-- Has_Volatile_Components (Flag87) -- Has_Volatile_Components (Flag87)
-- Is_Atomic (Flag85) -- Is_Atomic (Flag85)
-- Is_Eliminated (Flag124) -- Is_Eliminated (Flag124)
-- Is_Finalized_Transient (Flag252)
-- Is_Ignored_Transient (Flag295)
-- Is_Independent (Flag268) -- Is_Independent (Flag268)
-- Is_Processed_Transient (Flag252)
-- Is_Return_Object (Flag209) -- Is_Return_Object (Flag209)
-- Is_Safe_To_Reevaluate (Flag249) -- Is_Safe_To_Reevaluate (Flag249)
-- Is_Shared_Passive (Flag60) -- Is_Shared_Passive (Flag60)
...@@ -7062,6 +7070,7 @@ package Einfo is ...@@ -7062,6 +7070,7 @@ package Einfo is
function Is_Entry_Formal (Id : E) return B; function Is_Entry_Formal (Id : E) return B;
function Is_Exception_Handler (Id : E) return B; function Is_Exception_Handler (Id : E) return B;
function Is_Exported (Id : E) return B; function Is_Exported (Id : E) return B;
function Is_Finalized_Transient (Id : E) return B;
function Is_First_Subtype (Id : E) return B; function Is_First_Subtype (Id : E) return B;
function Is_For_Access_Subtype (Id : E) return B; function Is_For_Access_Subtype (Id : E) return B;
function Is_Frozen (Id : E) return B; function Is_Frozen (Id : E) return B;
...@@ -7070,6 +7079,7 @@ package Einfo is ...@@ -7070,6 +7079,7 @@ package Einfo is
function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B; function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B;
function Is_Hidden_Open_Scope (Id : E) return B; function Is_Hidden_Open_Scope (Id : E) return B;
function Is_Ignored_Ghost_Entity (Id : E) return B; function Is_Ignored_Ghost_Entity (Id : E) return B;
function Is_Ignored_Transient (Id : E) return B;
function Is_Immediately_Visible (Id : E) return B; function Is_Immediately_Visible (Id : E) return B;
function Is_Implementation_Defined (Id : E) return B; function Is_Implementation_Defined (Id : E) return B;
function Is_Imported (Id : E) return B; function Is_Imported (Id : E) return B;
...@@ -7108,7 +7118,6 @@ package Einfo is ...@@ -7108,7 +7118,6 @@ package Einfo is
function Is_Private_Composite (Id : E) return B; function Is_Private_Composite (Id : E) return B;
function Is_Private_Descendant (Id : E) return B; function Is_Private_Descendant (Id : E) return B;
function Is_Private_Primitive (Id : E) return B; function Is_Private_Primitive (Id : E) return B;
function Is_Processed_Transient (Id : E) return B;
function Is_Public (Id : E) return B; function Is_Public (Id : E) return B;
function Is_Pure (Id : E) return B; function Is_Pure (Id : E) return B;
function Is_Pure_Unit_Access_Type (Id : E) return B; function Is_Pure_Unit_Access_Type (Id : E) return B;
...@@ -7736,6 +7745,7 @@ package Einfo is ...@@ -7736,6 +7745,7 @@ package Einfo is
procedure Set_Is_Entry_Formal (Id : E; V : B := True); procedure Set_Is_Entry_Formal (Id : E; V : B := True);
procedure Set_Is_Exception_Handler (Id : E; V : B := True); procedure Set_Is_Exception_Handler (Id : E; V : B := True);
procedure Set_Is_Exported (Id : E; V : B := True); procedure Set_Is_Exported (Id : E; V : B := True);
procedure Set_Is_Finalized_Transient (Id : E; V : B := True);
procedure Set_Is_First_Subtype (Id : E; V : B := True); procedure Set_Is_First_Subtype (Id : E; V : B := True);
procedure Set_Is_For_Access_Subtype (Id : E; V : B := True); procedure Set_Is_For_Access_Subtype (Id : E; V : B := True);
procedure Set_Is_Formal_Subprogram (Id : E; V : B := True); procedure Set_Is_Formal_Subprogram (Id : E; V : B := True);
...@@ -7748,6 +7758,7 @@ package Einfo is ...@@ -7748,6 +7758,7 @@ package Einfo is
procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True); procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True);
procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True); procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True);
procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True); procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True);
procedure Set_Is_Ignored_Transient (Id : E; V : B := True);
procedure Set_Is_Immediately_Visible (Id : E; V : B := True); procedure Set_Is_Immediately_Visible (Id : E; V : B := True);
procedure Set_Is_Implementation_Defined (Id : E; V : B := True); procedure Set_Is_Implementation_Defined (Id : E; V : B := True);
procedure Set_Is_Imported (Id : E; V : B := True); procedure Set_Is_Imported (Id : E; V : B := True);
...@@ -7787,7 +7798,6 @@ package Einfo is ...@@ -7787,7 +7798,6 @@ package Einfo is
procedure Set_Is_Private_Composite (Id : E; V : B := True); procedure Set_Is_Private_Composite (Id : E; V : B := True);
procedure Set_Is_Private_Descendant (Id : E; V : B := True); procedure Set_Is_Private_Descendant (Id : E; V : B := True);
procedure Set_Is_Private_Primitive (Id : E; V : B := True); procedure Set_Is_Private_Primitive (Id : E; V : B := True);
procedure Set_Is_Processed_Transient (Id : E; V : B := True);
procedure Set_Is_Public (Id : E; V : B := True); procedure Set_Is_Public (Id : E; V : B := True);
procedure Set_Is_Pure (Id : E; V : B := True); procedure Set_Is_Pure (Id : E; V : B := True);
procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True); procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True);
...@@ -8544,6 +8554,7 @@ package Einfo is ...@@ -8544,6 +8554,7 @@ package Einfo is
pragma Inline (Is_Enumeration_Type); pragma Inline (Is_Enumeration_Type);
pragma Inline (Is_Exception_Handler); pragma Inline (Is_Exception_Handler);
pragma Inline (Is_Exported); pragma Inline (Is_Exported);
pragma Inline (Is_Finalized_Transient);
pragma Inline (Is_First_Subtype); pragma Inline (Is_First_Subtype);
pragma Inline (Is_Fixed_Point_Type); pragma Inline (Is_Fixed_Point_Type);
pragma Inline (Is_Floating_Point_Type); pragma Inline (Is_Floating_Point_Type);
...@@ -8563,6 +8574,7 @@ package Einfo is ...@@ -8563,6 +8574,7 @@ package Einfo is
pragma Inline (Is_Hidden_Non_Overridden_Subpgm); pragma Inline (Is_Hidden_Non_Overridden_Subpgm);
pragma Inline (Is_Hidden_Open_Scope); pragma Inline (Is_Hidden_Open_Scope);
pragma Inline (Is_Ignored_Ghost_Entity); pragma Inline (Is_Ignored_Ghost_Entity);
pragma Inline (Is_Ignored_Transient);
pragma Inline (Is_Immediately_Visible); pragma Inline (Is_Immediately_Visible);
pragma Inline (Is_Implementation_Defined); pragma Inline (Is_Implementation_Defined);
pragma Inline (Is_Imported); pragma Inline (Is_Imported);
...@@ -8612,7 +8624,6 @@ package Einfo is ...@@ -8612,7 +8624,6 @@ package Einfo is
pragma Inline (Is_Private_Descendant); pragma Inline (Is_Private_Descendant);
pragma Inline (Is_Private_Primitive); pragma Inline (Is_Private_Primitive);
pragma Inline (Is_Private_Type); pragma Inline (Is_Private_Type);
pragma Inline (Is_Processed_Transient);
pragma Inline (Is_Protected_Type); pragma Inline (Is_Protected_Type);
pragma Inline (Is_Public); pragma Inline (Is_Public);
pragma Inline (Is_Pure); pragma Inline (Is_Pure);
...@@ -9039,6 +9050,7 @@ package Einfo is ...@@ -9039,6 +9050,7 @@ package Einfo is
pragma Inline (Set_Is_Entry_Formal); pragma Inline (Set_Is_Entry_Formal);
pragma Inline (Set_Is_Exception_Handler); pragma Inline (Set_Is_Exception_Handler);
pragma Inline (Set_Is_Exported); pragma Inline (Set_Is_Exported);
pragma Inline (Set_Is_Finalized_Transient);
pragma Inline (Set_Is_First_Subtype); pragma Inline (Set_Is_First_Subtype);
pragma Inline (Set_Is_For_Access_Subtype); pragma Inline (Set_Is_For_Access_Subtype);
pragma Inline (Set_Is_Formal_Subprogram); pragma Inline (Set_Is_Formal_Subprogram);
...@@ -9051,6 +9063,7 @@ package Einfo is ...@@ -9051,6 +9063,7 @@ package Einfo is
pragma Inline (Set_Is_Hidden_Non_Overridden_Subpgm); pragma Inline (Set_Is_Hidden_Non_Overridden_Subpgm);
pragma Inline (Set_Is_Hidden_Open_Scope); pragma Inline (Set_Is_Hidden_Open_Scope);
pragma Inline (Set_Is_Ignored_Ghost_Entity); pragma Inline (Set_Is_Ignored_Ghost_Entity);
pragma Inline (Set_Is_Ignored_Transient);
pragma Inline (Set_Is_Immediately_Visible); pragma Inline (Set_Is_Immediately_Visible);
pragma Inline (Set_Is_Implementation_Defined); pragma Inline (Set_Is_Implementation_Defined);
pragma Inline (Set_Is_Imported); pragma Inline (Set_Is_Imported);
...@@ -9090,7 +9103,6 @@ package Einfo is ...@@ -9090,7 +9103,6 @@ package Einfo is
pragma Inline (Set_Is_Private_Composite); pragma Inline (Set_Is_Private_Composite);
pragma Inline (Set_Is_Private_Descendant); pragma Inline (Set_Is_Private_Descendant);
pragma Inline (Set_Is_Private_Primitive); pragma Inline (Set_Is_Private_Primitive);
pragma Inline (Set_Is_Processed_Transient);
pragma Inline (Set_Is_Public); pragma Inline (Set_Is_Public);
pragma Inline (Set_Is_Pure); pragma Inline (Set_Is_Pure);
pragma Inline (Set_Is_Pure_Unit_Access_Type); pragma Inline (Set_Is_Pure_Unit_Access_Type);
......
...@@ -4115,10 +4115,6 @@ package body Exp_Ch6 is ...@@ -4115,10 +4115,6 @@ package body Exp_Ch6 is
and then Present (Generalized_Indexing (Ref)); and then Present (Generalized_Indexing (Ref));
end Is_Element_Reference; end Is_Element_Reference;
-- Local variables
Is_Elem_Ref : constant Boolean := Is_Element_Reference (N);
-- Start of processing for Expand_Ctrl_Function_Call -- Start of processing for Expand_Ctrl_Function_Call
begin begin
...@@ -4142,20 +4138,24 @@ package body Exp_Ch6 is ...@@ -4142,20 +4138,24 @@ package body Exp_Ch6 is
Remove_Side_Effects (N); Remove_Side_Effects (N);
-- When the temporary function result appears inside a case expression -- The side effect removal of the function call produced a temporary.
-- or an if expression, its lifetime must be extended to match that of -- When the context is a case expression, if expression, or expression
-- the context. If not, the function result will be finalized too early -- with actions, the lifetime of the temporary must be extended to match
-- and the evaluation of the expression could yield incorrect result. An -- that of the context. Otherwise the function result will be finalized
-- exception to this rule are references to Ada 2012 container elements. -- too early and affect the result of the expression. To prevent this
-- unwanted effect, the temporary should not be considered for clean up
-- actions by the general finalization machinery.
-- Exception to this rule are references to Ada 2012 container elements.
-- Such references must be finalized at the end of each iteration of the -- Such references must be finalized at the end of each iteration of the
-- related quantified expression, otherwise the container will remain -- related quantified expression, otherwise the container will remain
-- busy. -- busy.
if not Is_Elem_Ref if Nkind (N) = N_Explicit_Dereference
and then Within_Case_Or_If_Expression (N) and then Within_Case_Or_If_Expression (N)
and then Nkind (N) = N_Explicit_Dereference and then not Is_Element_Reference (N)
then then
Set_Is_Processed_Transient (Entity (Prefix (N))); Set_Is_Ignored_Transient (Entity (Prefix (N)));
end if; end if;
end Expand_Ctrl_Function_Call; end Expand_Ctrl_Function_Call;
......
...@@ -1653,6 +1653,133 @@ package body Exp_Util is ...@@ -1653,6 +1653,133 @@ package body Exp_Util is
return Build_Task_Image_Function (Loc, Decls, Stats, Res); return Build_Task_Image_Function (Loc, Decls, Stats, Res);
end Build_Task_Record_Image; end Build_Task_Record_Image;
---------------------------------------
-- Build_Transient_Object_Statements --
---------------------------------------
procedure Build_Transient_Object_Statements
(Obj_Decl : Node_Id;
Fin_Call : out Node_Id;
Hook_Assign : out Node_Id;
Hook_Clear : out Node_Id;
Hook_Decl : out Node_Id;
Ptr_Decl : out Node_Id;
Finalize_Obj : Boolean := True)
is
Loc : constant Source_Ptr := Sloc (Obj_Decl);
Obj_Id : constant Entity_Id := Defining_Entity (Obj_Decl);
Obj_Typ : constant Entity_Id := Base_Type (Etype (Obj_Id));
Desig_Typ : Entity_Id;
Hook_Expr : Node_Id;
Hook_Id : Entity_Id;
Obj_Ref : Node_Id;
Ptr_Typ : Entity_Id;
begin
-- Recover the type of the object
Desig_Typ := Obj_Typ;
if Is_Access_Type (Desig_Typ) then
Desig_Typ := Available_View (Designated_Type (Desig_Typ));
end if;
-- Create an access type which provides a reference to the transient
-- object. Generate:
-- type Ptr_Typ is access all Desig_Typ;
Ptr_Typ := Make_Temporary (Loc, 'A');
Set_Ekind (Ptr_Typ, E_General_Access_Type);
Set_Directly_Designated_Type (Ptr_Typ, Desig_Typ);
Ptr_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 (Desig_Typ, Loc)));
-- Create a temporary check which acts as a hook to the transient
-- object. Generate:
-- Hook : Ptr_Typ := null;
Hook_Id := Make_Temporary (Loc, 'T');
Set_Ekind (Hook_Id, E_Variable);
Set_Etype (Hook_Id, Ptr_Typ);
Hook_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Hook_Id,
Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc),
Expression => Make_Null (Loc));
-- Mark the temporary as a hook. This signals the machinery in
-- Build_Finalizer to recognize this special case.
Set_Status_Flag_Or_Transient_Decl (Hook_Id, Obj_Decl);
-- Hook the transient object to the temporary. Generate:
-- Hook := Ptr_Typ (Obj_Id);
-- <or>
-- Hool := Obj_Id'Unrestricted_Access;
if Is_Access_Type (Obj_Typ) then
Hook_Expr :=
Unchecked_Convert_To (Ptr_Typ, New_Occurrence_Of (Obj_Id, Loc));
else
Hook_Expr :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Obj_Id, Loc),
Attribute_Name => Name_Unrestricted_Access);
end if;
Hook_Assign :=
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Hook_Id, Loc),
Expression => Hook_Expr);
-- Crear the hook prior to finalizing the object. Generate:
-- Hook := null;
Hook_Clear :=
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Hook_Id, Loc),
Expression => Make_Null (Loc));
-- Finalize the object. Generate:
-- [Deep_]Finalize (Obj_Ref[.all]);
if Finalize_Obj then
Obj_Ref := New_Occurrence_Of (Obj_Id, Loc);
if Is_Access_Type (Obj_Typ) then
Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref);
Set_Etype (Obj_Ref, Desig_Typ);
end if;
Fin_Call := Make_Final_Call (Obj_Ref, Desig_Typ);
-- Otherwise finalize the hook. Generate:
-- [Deep_]Finalize (Hook.all);
else
Fin_Call :=
Make_Final_Call (
Obj_Ref =>
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Hook_Id, Loc)),
Typ => Desig_Typ);
end if;
end Build_Transient_Object_Statements;
----------------------------- -----------------------------
-- Check_Float_Op_Overflow -- -- Check_Float_Op_Overflow --
----------------------------- -----------------------------
...@@ -5067,7 +5194,7 @@ package body Exp_Util is ...@@ -5067,7 +5194,7 @@ package body Exp_Util is
-- explicit aliases of it: -- explicit aliases of it:
-- do -- do
-- Trans_Id : Ctrl_Typ ...; -- controlled transient object -- Trans_Id : Ctrl_Typ ...; -- transient object
-- Alias : ... := Trans_Id; -- object is aliased -- Alias : ... := Trans_Id; -- object is aliased
-- Val : constant Boolean := -- Val : constant Boolean :=
-- ... Alias ...; -- aliasing ends -- ... Alias ...; -- aliasing ends
...@@ -5236,6 +5363,10 @@ package body Exp_Util is ...@@ -5236,6 +5363,10 @@ package body Exp_Util is
and then Requires_Transient_Scope (Desig) and then Requires_Transient_Scope (Desig)
and then Nkind (Rel_Node) /= N_Simple_Return_Statement and then Nkind (Rel_Node) /= N_Simple_Return_Statement
-- Do not consider a transient object that was already processed
and then not Is_Finalized_Transient (Obj_Id)
-- Do not consider renamed or 'reference-d transient objects because -- Do not consider renamed or 'reference-d transient objects because
-- the act of renaming extends the object's lifetime. -- the act of renaming extends the object's lifetime.
...@@ -8255,11 +8386,19 @@ package body Exp_Util is ...@@ -8255,11 +8386,19 @@ package body Exp_Util is
if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then
null; null;
-- Transient variables are treated separately in order to minimize -- Finalization of transient objects are treated separately in
-- the size of the generated code. See Exp_Ch7.Process_Transient_ -- order to handle sensitive cases. These include:
-- Objects.
elsif Is_Processed_Transient (Obj_Id) then -- * Aggregate expansion
-- * If, case, and expression with actions expansion
-- * Transient scopes
-- If one of those contexts has marked the transient object as
-- ignored, do not generate finalization actions for it.
elsif Is_Finalized_Transient (Obj_Id)
or else Is_Ignored_Transient (Obj_Id)
then
null; null;
-- Ignored Ghost objects do not need any cleanup actions because -- Ignored Ghost objects do not need any cleanup actions because
...@@ -8315,8 +8454,8 @@ package body Exp_Util is ...@@ -8315,8 +8454,8 @@ package body Exp_Util is
then then
return True; return True;
-- Processing for "hook" objects generated for controlled -- Processing for "hook" objects generated for transient objects
-- transients declared inside an Expression_With_Actions. -- declared inside an Expression_With_Actions.
elsif Is_Access_Type (Obj_Typ) elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id)) and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
...@@ -8464,7 +8603,7 @@ package body Exp_Util is ...@@ -8464,7 +8603,7 @@ package body Exp_Util is
elsif Nkind (Decl) = N_Block_Statement elsif Nkind (Decl) = N_Block_Statement
and then and then
-- Handle a rare case caused by a controlled transient variable -- Handle a rare case caused by a controlled transient object
-- created as part of a record init proc. The variable is wrapped -- created as part of a record init proc. The variable is wrapped
-- in a block, but the block is not associated with a transient -- in a block, but the block is not associated with a transient
-- scope. -- scope.
......
...@@ -280,6 +280,35 @@ package Exp_Util is ...@@ -280,6 +280,35 @@ package Exp_Util is
-- is false, the call is for a stand-alone object, and the generated -- is false, the call is for a stand-alone object, and the generated
-- function itself must do its own cleanups. -- function itself must do its own cleanups.
procedure Build_Transient_Object_Statements
(Obj_Decl : Node_Id;
Fin_Call : out Node_Id;
Hook_Assign : out Node_Id;
Hook_Clear : out Node_Id;
Hook_Decl : out Node_Id;
Ptr_Decl : out Node_Id;
Finalize_Obj : Boolean := True);
-- Subsidiary to the processing of transient objects in transient scopes,
-- if expressions, case expressions, expression_with_action nodes, array
-- aggregates, and record aggregates. Obj_Decl denotes the declaration of
-- the transient object. Generate the following nodes:
--
-- * Fin_Call - the call to [Deep_]Finalize which cleans up the transient
-- object if flag Finalize_Obj is set to True, or finalizes the hook when
-- the flag is False.
--
-- * Hook_Assign - the assignment statement which captures a reference to
-- the transient object in the hook.
--
-- * Hook_Clear - the assignment statement which resets the hook to null
--
-- * Hook_Decl - the declaration of the hook object
--
-- * Ptr_Decl - the full type declaration of the hook type
--
-- These nodes are inserted in specific places depending on the context by
-- the various Process_Transient_xxx routines.
procedure Check_Float_Op_Overflow (N : Node_Id); procedure Check_Float_Op_Overflow (N : Node_Id);
-- Called where we could have a floating-point binary operator where we -- Called where we could have a floating-point binary operator where we
-- must check for infinities if we are operating in Check_Float_Overflow -- must check for infinities if we are operating in Check_Float_Overflow
......
...@@ -4802,6 +4802,24 @@ package body Sem_Ch3 is ...@@ -4802,6 +4802,24 @@ package body Sem_Ch3 is
then then
Set_Has_Predicates (Id); Set_Has_Predicates (Id);
Set_Has_Delayed_Freeze (Id); Set_Has_Delayed_Freeze (Id);
-- Generated subtypes inherit the predicate function from the parent
-- (no aspects to examine on the generated declaration).
if not Comes_From_Source (N) then
Set_Ekind (Id, Ekind (T));
if Present (Predicate_Function (T)) then
Set_Predicate_Function (Id, Predicate_Function (T));
elsif Present (Ancestor_Subtype (T))
and then Has_Predicates (Ancestor_Subtype (T))
and then Present (Predicate_Function (Ancestor_Subtype (T)))
then
Set_Predicate_Function (Id,
Predicate_Function (Ancestor_Subtype (T)));
end if;
end if;
end if; end if;
-- Subtype of Boolean cannot have a constraint in SPARK -- Subtype of Boolean cannot have a constraint in SPARK
......
...@@ -9951,10 +9951,10 @@ package body Sem_Res is ...@@ -9951,10 +9951,10 @@ package body Sem_Res is
begin begin
-- Ensure all actions associated with the left operand (e.g. -- Ensure all actions associated with the left operand (e.g.
-- finalization of transient controlled objects) are fully evaluated -- finalization of transient objects) are fully evaluated locally within
-- locally within an expression with actions. This is particularly -- an expression with actions. This is particularly helpful for coverage
-- helpful for coverage analysis. However this should not happen in -- analysis. However this should not happen in generics or if option
-- generics or if Minimize_Expression_With_Actions is set. -- Minimize_Expression_With_Actions is set.
if Expander_Active and not Minimize_Expression_With_Actions then if Expander_Active and not Minimize_Expression_With_Actions then
declare declare
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment