Skip to content

R
riscv-gcc-1
Commit 937e9676 by Arnaud Charlet
Options

[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
Showing with 326 additions and 53 deletions
gcc/ada/ChangeLog
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.
2016-07-06 Arnaud Charlet <charlet@adacore.com>
......
gcc/ada/einfo.adb
......@@ -561,7 +561,7 @@ package body Einfo is
-- Has_Predicates Flag250
-- Has_Implicit_Dereference Flag251
-- Is_Processed_Transient Flag252
-- Is_Finalized_Transient Flag252
-- Disable_Controlled Flag253
-- Is_Implementation_Defined Flag254
-- Is_Predicate_Function Flag255
......@@ -609,8 +609,8 @@ package body Einfo is
-- Is_Partial_Invariant_Procedure Flag292
-- Is_Actual_Subtype Flag293
-- Has_Pragma_Unused Flag294
-- Is_Ignored_Transient Flag295
-- (unused) Flag295
-- (unused) Flag296
-- (unused) Flag297
-- (unused) Flag298
......@@ -2185,6 +2185,12 @@ package body Einfo is
return Flag99 (Id);
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
begin
return Flag70 (Id);
......@@ -2250,6 +2256,12 @@ package body Einfo is
return Flag278 (Id);
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
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -2466,12 +2478,6 @@ package body Einfo is
return Flag245 (Id);
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
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -5248,6 +5254,12 @@ package body Einfo is
Set_Flag99 (Id, V);
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
begin
Set_Flag70 (Id, V);
......@@ -5329,6 +5341,12 @@ package body Einfo is
Set_Flag278 (Id, V);
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
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -5543,12 +5561,6 @@ package body Einfo is
Set_Flag245 (Id, V);
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
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -9241,6 +9253,7 @@ package body Einfo is
W ("Is_Entry_Formal", Flag52 (Id));
W ("Is_Exception_Handler", Flag286 (Id));
W ("Is_Exported", Flag99 (Id));
W ("Is_Finalized_Transient", Flag252 (Id));
W ("Is_First_Subtype", Flag70 (Id));
W ("Is_For_Access_Subtype", Flag118 (Id));
W ("Is_Formal_Subprogram", Flag111 (Id));
......@@ -9253,6 +9266,7 @@ package body Einfo is
W ("Is_Hidden_Non_Overridden_Subpgm", Flag2 (Id));
W ("Is_Hidden_Open_Scope", Flag171 (Id));
W ("Is_Ignored_Ghost_Entity", Flag278 (Id));
W ("Is_Ignored_Transient", Flag295 (Id));
W ("Is_Immediately_Visible", Flag7 (Id));
W ("Is_Implementation_Defined", Flag254 (Id));
W ("Is_Imported", Flag24 (Id));
......@@ -9292,7 +9306,6 @@ package body Einfo is
W ("Is_Private_Composite", Flag107 (Id));
W ("Is_Private_Descendant", Flag53 (Id));
W ("Is_Private_Primitive", Flag245 (Id));
W ("Is_Processed_Transient", Flag252 (Id));
W ("Is_Public", Flag10 (Id));
W ("Is_Pure", Flag44 (Id));
W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
......
gcc/ada/einfo.ads
......@@ -535,7 +535,7 @@ package Einfo is
-- a build-in-place function call. Contains the relocated build-in-place
-- call after the expansion has decoupled the call from the object. This
-- 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]
-- Defined in record types. Set if a pragma Convention for the record
......@@ -2484,6 +2484,12 @@ package Einfo is
-- Applies to all entities, true for abstract states that are subject to
-- 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)
-- Applies to all entities, true for procedures containing finalization
-- code to process local or library level objects.
......@@ -2595,6 +2601,13 @@ package Einfo is
-- pragma Ghost or inherit "ghostness" from an enclosing construct, and
-- 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)
-- Defined in all entities. Set if entity is immediately visible, i.e.
-- is defined in some currently open scope (RM 8.3(4)).
......@@ -2997,13 +3010,6 @@ package Einfo is
-- Applies to all entities, true for private types and 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)
-- Applicable to all entities, true if the entity denotes a private
-- component of a protected type.
......@@ -5786,8 +5792,9 @@ package Einfo is
-- Has_Volatile_Components (Flag87)
-- Is_Atomic (Flag85)
-- Is_Eliminated (Flag124)
-- Is_Finalized_Transient (Flag252)
-- Is_Ignored_Transient (Flag295)
-- Is_Independent (Flag268)
-- Is_Processed_Transient (Flag252) (constants only)
-- Is_Return_Object (Flag209)
-- Is_True_Constant (Flag163)
-- Is_Uplevel_Referenced_Entity (Flag283)
......@@ -6552,8 +6559,9 @@ package Einfo is
-- Has_Volatile_Components (Flag87)
-- Is_Atomic (Flag85)
-- Is_Eliminated (Flag124)
-- Is_Finalized_Transient (Flag252)
-- Is_Ignored_Transient (Flag295)
-- Is_Independent (Flag268)
-- Is_Processed_Transient (Flag252)
-- Is_Return_Object (Flag209)
-- Is_Safe_To_Reevaluate (Flag249)
-- Is_Shared_Passive (Flag60)
......@@ -7062,6 +7070,7 @@ package Einfo is
function Is_Entry_Formal (Id : E) return B;
function Is_Exception_Handler (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_For_Access_Subtype (Id : E) return B;
function Is_Frozen (Id : E) return B;
......@@ -7070,6 +7079,7 @@ package Einfo is
function Is_Hidden_Non_Overridden_Subpgm (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_Transient (Id : E) return B;
function Is_Immediately_Visible (Id : E) return B;
function Is_Implementation_Defined (Id : E) return B;
function Is_Imported (Id : E) return B;
......@@ -7108,7 +7118,6 @@ package Einfo is
function Is_Private_Composite (Id : E) return B;
function Is_Private_Descendant (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_Pure (Id : E) return B;
function Is_Pure_Unit_Access_Type (Id : E) return B;
......@@ -7736,6 +7745,7 @@ package Einfo is
procedure Set_Is_Entry_Formal (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_Finalized_Transient (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_Formal_Subprogram (Id : E; V : B := True);
......@@ -7748,6 +7758,7 @@ package Einfo is
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_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_Implementation_Defined (Id : E; V : B := True);
procedure Set_Is_Imported (Id : E; V : B := True);
......@@ -7787,7 +7798,6 @@ package Einfo is
procedure Set_Is_Private_Composite (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_Processed_Transient (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_Unit_Access_Type (Id : E; V : B := True);
......@@ -8544,6 +8554,7 @@ package Einfo is
pragma Inline (Is_Enumeration_Type);
pragma Inline (Is_Exception_Handler);
pragma Inline (Is_Exported);
pragma Inline (Is_Finalized_Transient);
pragma Inline (Is_First_Subtype);
pragma Inline (Is_Fixed_Point_Type);
pragma Inline (Is_Floating_Point_Type);
......@@ -8563,6 +8574,7 @@ package Einfo is
pragma Inline (Is_Hidden_Non_Overridden_Subpgm);
pragma Inline (Is_Hidden_Open_Scope);
pragma Inline (Is_Ignored_Ghost_Entity);
pragma Inline (Is_Ignored_Transient);
pragma Inline (Is_Immediately_Visible);
pragma Inline (Is_Implementation_Defined);
pragma Inline (Is_Imported);
......@@ -8612,7 +8624,6 @@ package Einfo is
pragma Inline (Is_Private_Descendant);
pragma Inline (Is_Private_Primitive);
pragma Inline (Is_Private_Type);
pragma Inline (Is_Processed_Transient);
pragma Inline (Is_Protected_Type);
pragma Inline (Is_Public);
pragma Inline (Is_Pure);
......@@ -9039,6 +9050,7 @@ package Einfo is
pragma Inline (Set_Is_Entry_Formal);
pragma Inline (Set_Is_Exception_Handler);
pragma Inline (Set_Is_Exported);
pragma Inline (Set_Is_Finalized_Transient);
pragma Inline (Set_Is_First_Subtype);
pragma Inline (Set_Is_For_Access_Subtype);
pragma Inline (Set_Is_Formal_Subprogram);
......@@ -9051,6 +9063,7 @@ package Einfo is
pragma Inline (Set_Is_Hidden_Non_Overridden_Subpgm);
pragma Inline (Set_Is_Hidden_Open_Scope);
pragma Inline (Set_Is_Ignored_Ghost_Entity);
pragma Inline (Set_Is_Ignored_Transient);
pragma Inline (Set_Is_Immediately_Visible);
pragma Inline (Set_Is_Implementation_Defined);
pragma Inline (Set_Is_Imported);
......@@ -9090,7 +9103,6 @@ package Einfo is
pragma Inline (Set_Is_Private_Composite);
pragma Inline (Set_Is_Private_Descendant);
pragma Inline (Set_Is_Private_Primitive);
pragma Inline (Set_Is_Processed_Transient);
pragma Inline (Set_Is_Public);
pragma Inline (Set_Is_Pure);
pragma Inline (Set_Is_Pure_Unit_Access_Type);
......
gcc/ada/exp_ch6.adb
......@@ -4115,10 +4115,6 @@ package body Exp_Ch6 is
and then Present (Generalized_Indexing (Ref));
end Is_Element_Reference;
-- Local variables
Is_Elem_Ref : constant Boolean := Is_Element_Reference (N);
-- Start of processing for Expand_Ctrl_Function_Call
begin
......@@ -4142,20 +4138,24 @@ package body Exp_Ch6 is
Remove_Side_Effects (N);
-- When the temporary function result appears inside a case expression
-- or an if expression, its lifetime must be extended to match that of
-- the context. If not, the function result will be finalized too early
-- and the evaluation of the expression could yield incorrect result. An
-- exception to this rule are references to Ada 2012 container elements.
-- The side effect removal of the function call produced a temporary.
-- When the context is a case expression, if expression, or expression
-- with actions, the lifetime of the temporary must be extended to match
-- that of the context. Otherwise the function result will be finalized
-- 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
-- related quantified expression, otherwise the container will remain
-- busy.
if not Is_Elem_Ref
if Nkind (N) = N_Explicit_Dereference
and then Within_Case_Or_If_Expression (N)
and then Nkind (N) = N_Explicit_Dereference
and then not Is_Element_Reference (N)
then
Set_Is_Processed_Transient (Entity (Prefix (N)));
Set_Is_Ignored_Transient (Entity (Prefix (N)));
end if;
end Expand_Ctrl_Function_Call;
......
gcc/ada/exp_util.adb
......@@ -1653,6 +1653,133 @@ package body Exp_Util is
return Build_Task_Image_Function (Loc, Decls, Stats, Res);
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 --
-----------------------------
......@@ -5067,7 +5194,7 @@ package body Exp_Util is
-- explicit aliases of it:
-- do
-- Trans_Id : Ctrl_Typ ...; -- controlled transient object
-- Trans_Id : Ctrl_Typ ...; -- transient object
-- Alias : ... := Trans_Id; -- object is aliased
-- Val : constant Boolean :=
-- ... Alias ...; -- aliasing ends
......@@ -5236,6 +5363,10 @@ package body Exp_Util is
and then Requires_Transient_Scope (Desig)
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
-- the act of renaming extends the object's lifetime.
......@@ -8255,11 +8386,19 @@ package body Exp_Util is
if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then
null;
-- Transient variables are treated separately in order to minimize
-- the size of the generated code. See Exp_Ch7.Process_Transient_
-- Objects.
-- Finalization of transient objects are treated separately in
-- order to handle sensitive cases. These include:
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;
-- Ignored Ghost objects do not need any cleanup actions because
......@@ -8315,8 +8454,8 @@ package body Exp_Util is
then
return True;
-- Processing for "hook" objects generated for controlled
-- transients declared inside an Expression_With_Actions.
-- Processing for "hook" objects generated for transient objects
-- declared inside an Expression_With_Actions.
elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
......@@ -8464,7 +8603,7 @@ package body Exp_Util is
elsif Nkind (Decl) = N_Block_Statement
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
-- in a block, but the block is not associated with a transient
-- scope.
......
gcc/ada/exp_util.ads
......@@ -280,6 +280,35 @@ package Exp_Util is
-- is false, the call is for a stand-alone object, and the generated
-- 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);
-- Called where we could have a floating-point binary operator where we
-- must check for infinities if we are operating in Check_Float_Overflow
......
gcc/ada/sem_ch3.adb
......@@ -4802,6 +4802,24 @@ package body Sem_Ch3 is
then
Set_Has_Predicates (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;
-- Subtype of Boolean cannot have a constraint in SPARK
......
gcc/ada/sem_res.adb
......@@ -9951,10 +9951,10 @@ package body Sem_Res is
begin
-- Ensure all actions associated with the left operand (e.g.
-- finalization of transient controlled objects) are fully evaluated
-- locally within an expression with actions. This is particularly
-- helpful for coverage analysis. However this should not happen in
-- generics or if Minimize_Expression_With_Actions is set.
-- finalization of transient objects) are fully evaluated locally within
-- an expression with actions. This is particularly helpful for coverage
-- analysis. However this should not happen in generics or if option
-- Minimize_Expression_With_Actions is set.
if Expander_Active and not Minimize_Expression_With_Actions then
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