Skip to content

R
riscv-gcc-1
Commit 3cebd1c0 by Arnaud Charlet
Options

[multiple changes] 

2012-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Is_Object_Reference): in Ada 2012, qualified
	expressions are valid names.

2012-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Analyze_Compilation_Unit): If the unit is an
	instantiation do not emit warnings for obsolescent units. The
	warnings belong on the corresponding generic.

2012-06-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb: Update the usage of Node15.
	(Return_Flag_Or_Transient_Decl): Removed.
	(Set_Return_Flag_Or_Transient_Decl): Removed.
	(Set_Status_Flag_Or_Transient_Decl): New routine.
	(Status_Flag_Or_Transient_Decl): New routine.
	(Write_Field15_Name): Update the output for variables and constants.
	* einfo.ads: Remove attribute
	Return_Flag_Or_Transient_Decl along with occurrences in nodes.
	(Return_Flag_Or_Transient_Decl): Removed along with pragma Inline.
	(Set_Return_Flag_Or_Transient_Decl): Removed along with pragma Inline.
	(Set_Status_Flag_Or_Transient_Decl): New routine along with pragma
	Inline.
	(Status_Flag_Or_Transient_Decl): New routine along with pragma Inline.
	* exp_ch4.adb (Create_Alternative): New routine.
	(Expand_N_Conditional_Expression): Handle the case
	where at least one of the conditional expression
	alternatives prodices a controlled temporary by means of a function
	call.
	(Is_Controlled_Function_Call): New routine.
	(Process_Transient_Object): Update the call to
	Set_Return_Flag_Or_Transient_Decl.
	* exp_ch6.adb (Enclosing_Context): New routine.
	(Expand_N_Extended_Return_Statement): Update all calls to
	Set_Return_Flag_Or_Transient_Decl.
	(Expand_Ctrl_Function_Call): Prohibit the finalization of a controlled
	function result when the context is a conditional expression.
	* exp_ch7.adb (Process_Declarations): Update all calls to
	Return_Flag_Or_Transient_Decl. Add processing for intermediate
	results of conditional expressions where one of the alternatives
	uses a controlled function call.
	(Process_Object_Declaration): Update all calls to
	Return_Flag_Or_Transient_Decl and rearrange the logic to process
	"hook" objects first.
	(Process_Transient_Objects): Update the call to
	Set_Return_Flag_Or_Transient_Decl.
	* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean,
	Boolean)): Update all calls to Return_Flag_Or_Transient_Decl. Add
	detection for intermediate results of conditional expressions
	where one of the alternatives uses a controlled function call.

From-SVN: r188606
parent 7579786c
Showing with 337 additions and 111 deletions
gcc/ada/ChangeLog
2012-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Is_Object_Reference): in Ada 2012, qualified
expressions are valid names.
2012-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Analyze_Compilation_Unit): If the unit is an
instantiation do not emit warnings for obsolescent units. The
warnings belong on the corresponding generic.
2012-06-14 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb: Update the usage of Node15.
(Return_Flag_Or_Transient_Decl): Removed.
(Set_Return_Flag_Or_Transient_Decl): Removed.
(Set_Status_Flag_Or_Transient_Decl): New routine.
(Status_Flag_Or_Transient_Decl): New routine.
(Write_Field15_Name): Update the output for variables and constants.
* einfo.ads: Remove attribute
Return_Flag_Or_Transient_Decl along with occurrences in nodes.
(Return_Flag_Or_Transient_Decl): Removed along with pragma Inline.
(Set_Return_Flag_Or_Transient_Decl): Removed along with pragma Inline.
(Set_Status_Flag_Or_Transient_Decl): New routine along with pragma
Inline.
(Status_Flag_Or_Transient_Decl): New routine along with pragma Inline.
* exp_ch4.adb (Create_Alternative): New routine.
(Expand_N_Conditional_Expression): Handle the case
where at least one of the conditional expression
alternatives prodices a controlled temporary by means of a function
call.
(Is_Controlled_Function_Call): New routine.
(Process_Transient_Object): Update the call to
Set_Return_Flag_Or_Transient_Decl.
* exp_ch6.adb (Enclosing_Context): New routine.
(Expand_N_Extended_Return_Statement): Update all calls to
Set_Return_Flag_Or_Transient_Decl.
(Expand_Ctrl_Function_Call): Prohibit the finalization of a controlled
function result when the context is a conditional expression.
* exp_ch7.adb (Process_Declarations): Update all calls to
Return_Flag_Or_Transient_Decl. Add processing for intermediate
results of conditional expressions where one of the alternatives
uses a controlled function call.
(Process_Object_Declaration): Update all calls to
Return_Flag_Or_Transient_Decl and rearrange the logic to process
"hook" objects first.
(Process_Transient_Objects): Update the call to
Set_Return_Flag_Or_Transient_Decl.
* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean,
Boolean)): Update all calls to Return_Flag_Or_Transient_Decl. Add
detection for intermediate results of conditional expressions
where one of the alternatives uses a controlled function call.
2012-06-13 Eric Botcazou <ebotcazou@adacore.com>
Revert
......
gcc/ada/einfo.adb
......@@ -124,7 +124,7 @@ package body Einfo is
-- Extra_Formal Node15
-- Lit_Indexes Node15
-- Related_Instance Node15
-- Return_Flag_Or_Transient_Decl Node15
-- Status_Flag_Or_Transient_Decl Node15
-- Scale_Value Uint15
-- Storage_Size_Variable Node15
-- String_Literal_Low_Bound Node15
......@@ -2579,12 +2579,6 @@ package body Einfo is
return Flag213 (Id);
end Requires_Overriding;
function Return_Flag_Or_Transient_Decl (Id : E) return N is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
return Node15 (Id);
end Return_Flag_Or_Transient_Decl;
function Return_Present (Id : E) return B is
begin
return Flag54 (Id);
......@@ -2684,6 +2678,12 @@ package body Einfo is
return List25 (Id);
end Static_Predicate;
function Status_Flag_Or_Transient_Decl (Id : E) return N is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
return Node15 (Id);
end Status_Flag_Or_Transient_Decl;
function Storage_Size_Variable (Id : E) return E is
begin
pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
......@@ -5138,12 +5138,6 @@ package body Einfo is
Set_Flag213 (Id, V);
end Set_Requires_Overriding;
procedure Set_Return_Flag_Or_Transient_Decl (Id : E; V : E) is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
Set_Node15 (Id, V);
end Set_Return_Flag_Or_Transient_Decl;
procedure Set_Return_Present (Id : E; V : B := True) is
begin
Set_Flag54 (Id, V);
......@@ -5250,6 +5244,12 @@ package body Einfo is
Set_List25 (Id, V);
end Set_Static_Predicate;
procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E) is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
Set_Node15 (Id, V);
end Set_Status_Flag_Or_Transient_Decl;
procedure Set_Storage_Size_Variable (Id : E; V : E) is
begin
pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
......@@ -8238,13 +8238,13 @@ package body Einfo is
E_Package_Body =>
Write_Str ("Related_Instance");
when E_Constant |
E_Variable =>
Write_Str ("Return_Flag_Or_Transient_Decl");
when Decimal_Fixed_Point_Kind =>
Write_Str ("Scale_Value");
when E_Constant |
E_Variable =>
Write_Str ("Status_Flag_Or_Transient_Decl");
when Access_Kind |
Task_Kind =>
Write_Str ("Storage_Size_Variable");
......
gcc/ada/einfo.ads
......@@ -3508,15 +3508,6 @@ package Einfo is
-- is True only for implicitly declare subprograms; it is not set on the
-- parent type's subprogram. See also Is_Abstract_Subprogram.
-- Return_Flag_Or_Transient_Decl (Node15)
-- Applies to variables and constants. Set for objects which act as the
-- return value of an extended return statement. The node contains the
-- entity of a locally declared flag which controls the finalization of
-- the return object should the function fail. Also set for access-to-
-- controlled objects used to provide a hook to controlled transients
-- declared inside an Expression_With_Actions. The node contains the
-- object declaration of the controlled transient.
-- Return_Present (Flag54)
-- Present in function and generic function entities. Set if the
-- function contains a return statement (used for error checking).
......@@ -3687,6 +3678,14 @@ package Einfo is
-- type of the subtype. Note that all entries are static and have values
-- within the subtype range.
-- Status_Flag_Or_Transient_Decl (Node15)
-- Present in variables and constants. Applies to objects that require
-- special treatment by the finalization machinery. Such examples are
-- extended return results, conditional expression results and objects
-- inside N_Expression_With_Actions nodes. The attribute contains the
-- entity of a flag which specifies particular behavior over a region
-- of code or the declaration of a "hook" object.
-- Storage_Size_Variable (Node15) [implementation base type only]
-- Present in access types and task type entities. This flag is set
-- if a valid and effective pragma Storage_Size applies to the base
......@@ -5086,7 +5085,7 @@ package Einfo is
-- Esize (Uint12)
-- Extra_Accessibility (Node13) (constants only)
-- Alignment (Uint14)
-- Return_Flag_Or_Transient_Decl (Node15) (constants only)
-- Status_Flag_Or_Transient_Decl (Node15) (constants only)
-- Actual_Subtype (Node17)
-- Renamed_Object (Node18)
-- Size_Check_Code (Node19) (constants only)
......@@ -5747,7 +5746,7 @@ package Einfo is
-- Esize (Uint12)
-- Extra_Accessibility (Node13)
-- Alignment (Uint14)
-- Return_Flag_Or_Transient_Decl (Node15) (transient object only)
-- Status_Flag_Or_Transient_Decl (Node15) (transient object only)
-- Unset_Reference (Node16)
-- Actual_Subtype (Node17)
-- Renamed_Object (Node18)
......@@ -6367,7 +6366,6 @@ package Einfo is
function Renaming_Map (Id : E) return U;
function Requires_Overriding (Id : E) return B;
function Return_Applies_To (Id : E) return N;
function Return_Flag_Or_Transient_Decl (Id : E) return E;
function Return_Present (Id : E) return B;
function Returns_By_Ref (Id : E) return B;
function Reverse_Bit_Order (Id : E) return B;
......@@ -6386,6 +6384,7 @@ package Einfo is
function Static_Elaboration_Desired (Id : E) return B;
function Static_Initialization (Id : E) return N;
function Static_Predicate (Id : E) return S;
function Status_Flag_Or_Transient_Decl (Id : E) return E;
function Storage_Size_Variable (Id : E) return E;
function Stored_Constraint (Id : E) return L;
function Strict_Alignment (Id : E) return B;
......@@ -6963,7 +6962,6 @@ package Einfo is
procedure Set_Renaming_Map (Id : E; V : U);
procedure Set_Requires_Overriding (Id : E; V : B := True);
procedure Set_Return_Applies_To (Id : E; V : N);
procedure Set_Return_Flag_Or_Transient_Decl (Id : E; V : E);
procedure Set_Return_Present (Id : E; V : B := True);
procedure Set_Returns_By_Ref (Id : E; V : B := True);
procedure Set_Reverse_Bit_Order (Id : E; V : B := True);
......@@ -6982,6 +6980,7 @@ package Einfo is
procedure Set_Static_Elaboration_Desired (Id : E; V : B);
procedure Set_Static_Initialization (Id : E; V : N);
procedure Set_Static_Predicate (Id : E; V : S);
procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E);
procedure Set_Storage_Size_Variable (Id : E; V : E);
procedure Set_Stored_Constraint (Id : E; V : L);
procedure Set_Strict_Alignment (Id : E; V : B := True);
......@@ -7740,7 +7739,6 @@ package Einfo is
pragma Inline (Renaming_Map);
pragma Inline (Requires_Overriding);
pragma Inline (Return_Applies_To);
pragma Inline (Return_Flag_Or_Transient_Decl);
pragma Inline (Return_Present);
pragma Inline (Returns_By_Ref);
pragma Inline (Reverse_Bit_Order);
......@@ -7759,6 +7757,7 @@ package Einfo is
pragma Inline (Static_Elaboration_Desired);
pragma Inline (Static_Initialization);
pragma Inline (Static_Predicate);
pragma Inline (Status_Flag_Or_Transient_Decl);
pragma Inline (Storage_Size_Variable);
pragma Inline (Stored_Constraint);
pragma Inline (Strict_Alignment);
......@@ -8142,7 +8141,6 @@ package Einfo is
pragma Inline (Set_Renaming_Map);
pragma Inline (Set_Requires_Overriding);
pragma Inline (Set_Return_Applies_To);
pragma Inline (Set_Return_Flag_Or_Transient_Decl);
pragma Inline (Set_Return_Present);
pragma Inline (Set_Returns_By_Ref);
pragma Inline (Set_Reverse_Bit_Order);
......@@ -8161,6 +8159,7 @@ package Einfo is
pragma Inline (Set_Static_Elaboration_Desired);
pragma Inline (Set_Static_Initialization);
pragma Inline (Set_Static_Predicate);
pragma Inline (Set_Status_Flag_Or_Transient_Decl);
pragma Inline (Set_Storage_Size_Variable);
pragma Inline (Set_Stored_Constraint);
pragma Inline (Set_Strict_Alignment);
......
gcc/ada/exp_ch4.adb
......@@ -4267,19 +4267,83 @@ package body Exp_Ch4 is
-- Deal with limited types and condition actions
procedure Expand_N_Conditional_Expression (N : Node_Id) is
function Create_Alternative
(Loc : Source_Ptr;
Temp_Id : Entity_Id;
Flag_Id : Entity_Id;
Expr : Node_Id) return List_Id;
-- Build the statements of a "then" or "else" conditional expression
-- alternative. Temp_Id is the conditional expression result, Flag_Id
-- is a finalization flag created to service expression Expr.
function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean;
-- Determine whether an expression is a rewritten controlled function
-- call.
------------------------
-- Create_Alternative --
------------------------
function Create_Alternative
(Loc : Source_Ptr;
Temp_Id : Entity_Id;
Flag_Id : Entity_Id;
Expr : Node_Id) return List_Id
is
Result : constant List_Id := New_List;
begin
-- Generate:
-- Fnn := True;
if Present (Flag_Id)
and then not Is_Controlled_Function_Call (Expr)
then
Append_To (Result,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Flag_Id, Loc),
Expression => New_Reference_To (Standard_True, Loc)));
end if;
-- Generate:
-- Cnn := <expr>'Unrestricted_Access;
Append_To (Result,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Expr),
Attribute_Name => Name_Unrestricted_Access)));
return Result;
end Create_Alternative;
---------------------------------
-- Is_Controlled_Function_Call --
---------------------------------
function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean is
begin
return
Nkind (Original_Node (Expr)) = N_Function_Call
and then Needs_Finalization (Etype (Expr));
end Is_Controlled_Function_Call;
-- Local variables
Loc : constant Source_Ptr := Sloc (N);
Cond : constant Node_Id := First (Expressions (N));
Thenx : constant Node_Id := Next (Cond);
Elsex : constant Node_Id := Next (Thenx);
Typ : constant Entity_Id := Etype (N);
Actions : List_Id;
Cnn : Entity_Id;
Decl : Node_Id;
Expr : Node_Id;
New_If : Node_Id;
New_N : Node_Id;
P_Decl : Node_Id;
Expr : Node_Id;
Actions : List_Id;
begin
-- Fold at compile time if condition known. We have already folded
......@@ -4354,48 +4418,69 @@ package body Exp_Ch4 is
if Is_By_Reference_Type (Typ)
and then not Back_End_Handles_Limited_Types
then
Cnn := Make_Temporary (Loc, 'C', N);
declare
Flag_Id : Entity_Id;
Ptr_Typ : Entity_Id;
P_Decl :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier =>
Make_Temporary (Loc, 'A'),
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication => New_Reference_To (Typ, Loc)));
begin
Flag_Id := Empty;
Insert_Action (N, P_Decl);
-- At least one of the conditional expression alternatives uses a
-- controlled function to provide the result. Create a status flag
-- to signal the finalization machinery that Cnn needs special
-- handling.
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition =>
New_Occurrence_Of (Defining_Identifier (P_Decl), Loc));
New_If :=
Make_Implicit_If_Statement (N,
Condition => Relocate_Node (Cond),
Then_Statements => New_List (
Make_Assignment_Statement (Sloc (Thenx),
Name => New_Occurrence_Of (Cnn, Sloc (Thenx)),
Expression =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Unrestricted_Access,
Prefix => Relocate_Node (Thenx)))),
if Is_Controlled_Function_Call (Thenx)
or else Is_Controlled_Function_Call (Elsex)
then
Flag_Id := Make_Temporary (Loc, 'F');
Else_Statements => New_List (
Make_Assignment_Statement (Sloc (Elsex),
Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
Expression =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Unrestricted_Access,
Prefix => Relocate_Node (Elsex)))));
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Flag_Id,
Object_Definition =>
New_Reference_To (Standard_Boolean, Loc),
Expression =>
New_Reference_To (Standard_False, Loc)));
end if;
New_N :=
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Cnn, Loc));
-- Generate:
-- type Ann is access all Typ;
Ptr_Typ := Make_Temporary (Loc, 'A');
Insert_Action (N,
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Ptr_Typ,
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication => New_Reference_To (Typ, Loc))));
-- Generate:
-- Cnn : Ann;
Cnn := Make_Temporary (Loc, 'C', N);
Set_Ekind (Cnn, E_Variable);
Set_Status_Flag_Or_Transient_Decl (Cnn, Flag_Id);
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc));
New_If :=
Make_Implicit_If_Statement (N,
Condition => Relocate_Node (Cond),
Then_Statements =>
Create_Alternative (Sloc (Thenx), Cnn, Flag_Id, Thenx),
Else_Statements =>
Create_Alternative (Sloc (Elsex), Cnn, Flag_Id, Elsex));
New_N :=
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Cnn, Loc));
end;
-- For other types, we only need to expand if there are other actions
-- associated with either branch.
......@@ -4632,7 +4717,7 @@ package body Exp_Ch4 is
-- transient declaration out of the Actions list. This signals the
-- machinery in Build_Finalizer to recognize this special case.
Set_Return_Flag_Or_Transient_Decl (Temp_Id, Decl);
Set_Status_Flag_Or_Transient_Decl (Temp_Id, Decl);
-- Step 3: Hook the transient object to the temporary
......
gcc/ada/exp_ch6.adb
......@@ -4031,6 +4031,42 @@ package body Exp_Ch6 is
-------------------------------
procedure Expand_Ctrl_Function_Call (N : Node_Id) is
function Enclosing_Context return Node_Id;
-- Find the enclosing context where the function call appears
-----------------------
-- Enclosing_Context --
-----------------------
function Enclosing_Context return Node_Id is
Context : Node_Id;
begin
Context := Parent (N);
while Present (Context) loop
if Nkind (Context) = N_Conditional_Expression then
exit;
-- Stop the search when reaching any statement because we have
-- gone too far up the tree.
elsif Nkind (Context) = N_Procedure_Call_Statement
or else Nkind (Context) in N_Statement_Other_Than_Procedure_Call
then
exit;
end if;
Context := Parent (Context);
end loop;
return Context;
end Enclosing_Context;
-- Local variables
Context : constant Node_Id := Enclosing_Context;
begin
-- Optimization, if the returned value (which is on the sec-stack) is
-- returned again, no need to copy/readjust/finalize, we can just pass
......@@ -4051,6 +4087,18 @@ package body Exp_Ch6 is
-- the function using 'reference.
Remove_Side_Effects (N);
-- The function call is part of a conditional expression alternative.
-- The temporary result must live as long as the conditional expression
-- itself, otherwise it will be finalized too early. Mark the transient
-- as processed to avoid untimely finalization.
if Present (Context)
and then Nkind (Context) = N_Conditional_Expression
and then Nkind (N) = N_Explicit_Dereference
then
Set_Is_Processed_Transient (Entity (Prefix (N)));
end if;
end Expand_Ctrl_Function_Call;
-------------------------
......@@ -5503,7 +5551,7 @@ package body Exp_Ch6 is
-- Create a flag to track the function state
Flag_Id := Make_Temporary (Loc, 'F');
Set_Return_Flag_Or_Transient_Decl (Ret_Obj_Id, Flag_Id);
Set_Status_Flag_Or_Transient_Decl (Ret_Obj_Id, Flag_Id);
-- Insert the flag at the beginning of the function declarations,
-- generate:
......@@ -5582,7 +5630,7 @@ package body Exp_Ch6 is
then
declare
Flag_Id : constant Entity_Id :=
Return_Flag_Or_Transient_Decl (Ret_Obj_Id);
Status_Flag_Or_Transient_Decl (Ret_Obj_Id);
begin
-- Generate:
......
gcc/ada/exp_ch7.adb
......@@ -1884,11 +1884,24 @@ package body Exp_Ch7 is
-- transients declared inside an Expression_With_Actions.
elsif Is_Access_Type (Obj_Typ)
and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Object_Declaration
and then Is_Finalizable_Transient
(Return_Flag_Or_Transient_Decl (Obj_Id), Decl)
(Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
then
Processing_Actions (Has_No_Init => True);
-- Processing for intermediate results of conditional
-- expressions where one of the alternatives uses a controlled
-- function call.
elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Defining_Identifier
and then Present (Expr)
and then Nkind (Expr) = N_Null
then
Processing_Actions (Has_No_Init => True);
......@@ -1954,7 +1967,7 @@ package body Exp_Ch7 is
elsif Needs_Finalization (Obj_Typ)
and then Is_Return_Object (Obj_Id)
and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
then
Processing_Actions (Has_No_Init => True);
......@@ -2685,27 +2698,8 @@ package body Exp_Ch7 is
end if;
if Ekind_In (Obj_Id, E_Constant, E_Variable)
and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
then
-- Return objects use a flag to aid their potential
-- finalization when the enclosing function fails to return
-- properly. Generate:
-- if not Flag then
-- <object finalization statements>
-- end if;
if Is_Return_Object (Obj_Id) then
Fin_Stmts := New_List (
Make_If_Statement (Loc,
Condition =>
Make_Op_Not (Loc,
Right_Opnd =>
New_Reference_To
(Return_Flag_Or_Transient_Decl (Obj_Id), Loc)),
Then_Statements => Fin_Stmts));
-- Temporaries created for the purpose of "exporting" a
-- controlled transient out of an Expression_With_Actions (EWA)
-- need guards. The following illustrates the usage of such
......@@ -2733,11 +2727,9 @@ package body Exp_Ch7 is
-- <object finalization statements>
-- end if;
else
pragma Assert
(Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
N_Object_Declaration);
if Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Object_Declaration
then
Fin_Stmts := New_List (
Make_If_Statement (Loc,
Condition =>
......@@ -2746,6 +2738,25 @@ package body Exp_Ch7 is
Right_Opnd => Make_Null (Loc)),
Then_Statements => Fin_Stmts));
-- Return objects use a flag to aid their potential
-- finalization when the enclosing function fails to return
-- properly. Generate:
-- if not Flag then
-- <object finalization statements>
-- end if;
else
Fin_Stmts := New_List (
Make_If_Statement (Loc,
Condition =>
Make_Op_Not (Loc,
Right_Opnd =>
New_Reference_To
(Status_Flag_Or_Transient_Decl (Obj_Id), Loc)),
Then_Statements => Fin_Stmts));
end if;
end if;
end if;
......@@ -4475,7 +4486,7 @@ package body Exp_Ch7 is
-- the machinery in Build_Finalizer to recognize this
-- special case.
Set_Return_Flag_Or_Transient_Decl (Temp_Id, Stmt);
Set_Status_Flag_Or_Transient_Decl (Temp_Id, Stmt);
-- Step 3: Hook the transient object to the temporary
......
gcc/ada/exp_util.adb
......@@ -7179,11 +7179,23 @@ package body Exp_Util is
-- transients declared inside an Expression_With_Actions.
elsif Is_Access_Type (Obj_Typ)
and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Object_Declaration
and then Is_Finalizable_Transient
(Return_Flag_Or_Transient_Decl (Obj_Id), Decl)
(Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
then
return True;
-- Processing for intermediate results of conditional expressions
-- where one of the alternatives uses a controlled function call.
elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Defining_Identifier
and then Present (Expr)
and then Nkind (Expr) = N_Null
then
return True;
......@@ -7218,7 +7230,7 @@ package body Exp_Util is
elsif Needs_Finalization (Obj_Typ)
and then Is_Return_Object (Obj_Id)
and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
then
return True;
......
gcc/ada/sem_ch10.adb
......@@ -1257,10 +1257,15 @@ package body Sem_Ch10 is
-- know if the with'ing unit is itself obsolescent (which suppresses
-- the warnings).
if not GNAT_Mode and then Warn_On_Obsolescent_Feature then
if not GNAT_Mode
and then Warn_On_Obsolescent_Feature
and then Nkind (Unit_Node) not in N_Generic_Instantiation
then
-- Push current compilation unit as scope, so that the test for
-- being within an obsolescent unit will work correctly.
-- being within an obsolescent unit will work correctly. The check
-- is not performed within an instantiation, because the warning
-- will have been emitted in the corresponding generic unit.
Push_Scope (Defining_Entity (Unit_Node));
......
gcc/ada/sem_util.adb
......@@ -7745,6 +7745,19 @@ package body Sem_Util is
when N_String_Literal =>
return Is_Internally_Generated_Renaming (Parent (N));
-- AI05-0003: in Ada 2012, a qualified expression is a name.
-- This allows disambiguation of function calls and the use of
-- aggregates in more contexts.
when N_Qualified_Expression =>
if Ada_Version < Ada_2012 then
return False;
else
return Is_Object_Reference (Expression (N))
or else Nkind (Expression (N)) = N_Aggregate;
end if;
when others =>
return False;
end case;
......
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