procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2013-01-04  Thomas Quinot  <quinot@adacore.com>

	* sinfo.ads: Minor documentation update.

2013-01-04  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb, einfo.adb (Analyze_Object_Declaration): Do not set Ekind
	before resolving initialization expression.

2013-01-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Generate_Index_Checks): Delay the generation of
	the check for an indexed component where the prefix mentions
	Loop_Entry until the attribute has been properly expanded.
	* exp_ch5.adb (Expand_Loop_Entry_Attributes): Perform minor
	decoration of the constant that captures the value of Loop_Entry's
	prefix at the entry point into a loop.	Generate index checks
	for an attribute reference that has been transformed into an
	indexed component.

2013-01-04  Thomas Quinot  <quinot@adacore.com>

	* exp_prag.adb, exp_util.adb, exp_util.ads, freeze.adb, exp_aggr.adb,
	sem_ch13.adb (Exp_Aggr.Collect_Initialization_Statements): Nothing to
	do if Obj is already frozen.
	(Exp_Util.Find_Init_Call): Rename to...
	(Exp_Util.Remove_Init_Call): New subprogram, renamed from
	Find_Init_Call.  Remove the initialization call from the enclosing
	list if found, and if it is from an Initialization_Statements
	attribute, reset it.
	(Exp_Util.Append_Freeze_Action): Minor code reorganization.
	(Exp_Util.Append_Freeze_Actions): Ensure a freeze node has been
	allocated (as is already done in Append_Freeze_Action).
	(Freeze.Freeze_Entity): For an object with captured
	Initialization_Statements and non-delayed freezeing, unwrap the
	initialization statements and insert and them directly in the
	enclosing list.
	(Sem_Ch13.Check_Address_Clause): For an object
	with Initialization_Statements and an address clause, unwrap the
	initialization statements when moving them to the freeze actions.

From-SVN: r194887
This commit is contained in:
Arnaud Charlet 2013-01-04 10:08:50 +01:00
parent 576f6da639
commit 3a3af4c32c
12 changed files with 269 additions and 145 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
gcc/ada/ChangeLog
View file

@ -1,3 +1,44 @@
2013-01-04 Thomas Quinot <quinot@adacore.com>
* sinfo.ads: Minor documentation update.
2013-01-04 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb, einfo.adb (Analyze_Object_Declaration): Do not set Ekind
before resolving initialization expression.
2013-01-04 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Generate_Index_Checks): Delay the generation of
the check for an indexed component where the prefix mentions
Loop_Entry until the attribute has been properly expanded.
* exp_ch5.adb (Expand_Loop_Entry_Attributes): Perform minor
decoration of the constant that captures the value of Loop_Entry's
prefix at the entry point into a loop. Generate index checks
for an attribute reference that has been transformed into an
indexed component.
2013-01-04 Thomas Quinot <quinot@adacore.com>
* exp_prag.adb, exp_util.adb, exp_util.ads, freeze.adb, exp_aggr.adb,
sem_ch13.adb (Exp_Aggr.Collect_Initialization_Statements): Nothing to
do if Obj is already frozen.
(Exp_Util.Find_Init_Call): Rename to...
(Exp_Util.Remove_Init_Call): New subprogram, renamed from
Find_Init_Call. Remove the initialization call from the enclosing
list if found, and if it is from an Initialization_Statements
attribute, reset it.
(Exp_Util.Append_Freeze_Action): Minor code reorganization.
(Exp_Util.Append_Freeze_Actions): Ensure a freeze node has been
allocated (as is already done in Append_Freeze_Action).
(Freeze.Freeze_Entity): For an object with captured
Initialization_Statements and non-delayed freezeing, unwrap the
initialization statements and insert and them directly in the
enclosing list.
(Sem_Ch13.Check_Address_Clause): For an object
with Initialization_Statements and an address clause, unwrap the
initialization statements when moving them to the freeze actions.
2013-01-03 Pascal Obry <obry@adacore.com>
* prj-attr.adb, projects.texi, snames.ads-tmpl: Add package remote and

17
gcc/ada/checks.adb
View file

@ -5522,6 +5522,23 @@ package body Checks is
or else Index_Checks_Suppressed (Etype (A))
then
return;
-- The indexed component we are dealing with contains 'Loop_Entry in its
-- prefix. This case arises when analysis has determined that constructs
-- such as
-- Prefix'Loop_Entry (Expr)
-- Prefix'Loop_Entry (Expr1, Expr2, ... ExprN)
-- require rewriting for error detection purposes. A side effect of this
-- action is the generation of index checks that mention 'Loop_Entry.
-- Delay the generation of the check until 'Loop_Entry has been properly
-- expanded. This is done in Expand_Loop_Entry_Attributes.
elsif Nkind (Prefix (N)) = N_Attribute_Reference
and then Attribute_Name (Prefix (N)) = Name_Loop_Entry
then
return;
end if;
-- Generate a raise of constraint error with the appropriate reason and

6
gcc/ada/einfo.adb
View file

@ -4263,7 +4263,11 @@ package body Einfo is
procedure Set_Initialization_Statements (Id : E; V : N) is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
-- Tolerate an E_Void entity since this can be called while resolving
-- an aggregate used as the initialization expression for an object
-- declaration, and this occurs before the Ekind for the object is set.
pragma Assert (Ekind_In (Id, E_Void, E_Constant, E_Variable));
Set_Node28 (Id, V);
end Set_Initialization_Statements;

14
gcc/ada/exp_aggr.adb
View file

@ -106,9 +106,10 @@ package body Exp_Aggr is
(Obj : Entity_Id;
N : Node_Id;
Node_After : Node_Id);
-- Collect actions inserted after N until, but not including, Node_After,
-- for initialization of Obj, and move them to an expression with actions,
-- which becomes the Initialization_Statements for Obj.
-- If Obj is not frozen, collect actions inserted after N until, but not
-- including, Node_After, for initialization of Obj, and move them to an
-- expression with actions, which becomes the Initialization_Statements for
-- Obj.
------------------------------------------------------
-- Local subprograms for Record Aggregate Expansion --
@ -2965,6 +2966,13 @@ package body Exp_Aggr is
EA : Node_Id;
Init_Actions : constant List_Id := New_List;
begin
-- Nothing to do if Obj is already frozen, as in this case we known we
-- won't need to move the initialization statements about later on.
if Is_Frozen (Obj) then
return;
end if;
Init_Node := N;
while Next (Init_Node) /= Node_After loop

18
gcc/ada/exp_ch5.adb
View file

@ -1828,11 +1828,29 @@ package body Exp_Ch5 is
Object_Definition => New_Reference_To (Typ, Loc),
Expression => Relocate_Node (Prefix (LE))));
-- Perform minor decoration as this information will be needed for
-- the creation of index checks (if applicable).
Set_Ekind (Temp, E_Constant);
Set_Etype (Temp, Typ);
-- Replace the original attribute with a reference to the constant
Rewrite (LE, New_Reference_To (Temp, Loc));
Set_Etype (LE, Typ);
-- Analysis converts attribute references of the following form
-- Prefix'Loop_Entry (Expr)
-- Prefix'Loop_Entry (Expr1, Expr2, ... ExprN)
-- into indexed components for error detection purposes. Generate
-- index checks now that 'Loop_Entry has been properly expanded.
if Nkind (Parent (LE)) = N_Indexed_Component then
Generate_Index_Checks (Parent (LE));
end if;
Next_Elmt (LE_Elmt);
end loop;

7
gcc/ada/exp_prag.adb
View file

@ -549,12 +549,9 @@ package body Exp_Prag is
Def_Id := Entity (Arg2 (N));
if Ekind (Def_Id) = E_Variable then
-- Find generated initialization call for object, if any
-- Find and remove generated initialization call for object, if any
Init_Call := Find_Init_Call (Def_Id, Rep_Clause => N);
if Present (Init_Call) then
Remove (Init_Call);
end if;
Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
-- Any default initialization expression should be removed
-- (e.g., null defaults for access objects, zero initialization

214
gcc/ada/exp_util.adb
View file

@ -366,10 +366,11 @@ package body Exp_Util is
Fnode := Freeze_Node (T);
if No (Actions (Fnode)) then
Set_Actions (Fnode, New_List);
Set_Actions (Fnode, New_List (N));
else
Append (N, Actions (Fnode));
end if;
Append (N, Actions (Fnode));
end Append_Freeze_Action;
---------------------------
@ -377,18 +378,20 @@ package body Exp_Util is
---------------------------
procedure Append_Freeze_Actions (T : Entity_Id; L : List_Id) is
Fnode : constant Node_Id := Freeze_Node (T);
Fnode : Node_Id;
begin
if No (L) then
return;
end if;
Ensure_Freeze_Node (T);
Fnode := Freeze_Node (T);
if No (Actions (Fnode)) then
Set_Actions (Fnode, L);
else
if No (Actions (Fnode)) then
Set_Actions (Fnode, L);
else
Append_List (L, Actions (Fnode));
end if;
Append_List (L, Actions (Fnode));
end if;
end Append_Freeze_Actions;
@ -2160,101 +2163,6 @@ package body Exp_Util is
end if;
end Expand_Subtype_From_Expr;
--------------------
-- Find_Init_Call --
--------------------
function Find_Init_Call
(Var : Entity_Id;
Rep_Clause : Node_Id) return Node_Id
is
Par : constant Node_Id := Parent (Var);
Typ : constant Entity_Id := Etype (Var);
Init_Proc : Entity_Id;
-- Initialization procedure for Typ
function Find_Init_Call_In_List (From : Node_Id) return Node_Id;
-- Look for init call for Var starting at From and scanning the
-- enclosing list until Rep_Clause or the end of the list is reached.
----------------------------
-- Find_Init_Call_In_List --
----------------------------
function Find_Init_Call_In_List (From : Node_Id) return Node_Id is
Init_Call : Node_Id;
begin
Init_Call := From;
while Present (Init_Call) and then Init_Call /= Rep_Clause loop
if Nkind (Init_Call) = N_Procedure_Call_Statement
and then Is_Entity_Name (Name (Init_Call))
and then Entity (Name (Init_Call)) = Init_Proc
then
return Init_Call;
end if;
Next (Init_Call);
end loop;
return Empty;
end Find_Init_Call_In_List;
Init_Call : Node_Id;
-- Start of processing for Find_Init_Call
begin
if Present (Initialization_Statements (Var)) then
return Initialization_Statements (Var);
elsif not Has_Non_Null_Base_Init_Proc (Typ) then
-- No init proc for the type, so obviously no call to be found
return Empty;
end if;
-- We might be able to handle other cases below by just properly setting
-- Initialization_Statements at the point where the init proc call is
-- generated???
Init_Proc := Base_Init_Proc (Typ);
-- First scan the list containing the declaration of Var
Init_Call := Find_Init_Call_In_List (From => Next (Par));
-- If not found, also look on Var's freeze actions list, if any, since
-- the init call may have been moved there (case of an address clause
-- applying to Var).
if No (Init_Call) and then Present (Freeze_Node (Var)) then
Init_Call :=
Find_Init_Call_In_List (First (Actions (Freeze_Node (Var))));
end if;
-- If the initialization call has actuals that use the secondary stack,
-- the call may have been wrapped into a temporary block, in which case
-- the block itself has to be removed.
if No (Init_Call) and then Nkind (Next (Par)) = N_Block_Statement then
declare
Blk : constant Node_Id := Next (Par);
begin
if Present
(Find_Init_Call_In_List
(First (Statements (Handled_Statement_Sequence (Blk)))))
then
Init_Call := Blk;
end if;
end;
end if;
return Init_Call;
end Find_Init_Call;
------------------------
-- Find_Interface_ADT --
------------------------
@ -6295,6 +6203,106 @@ package body Exp_Util is
end case;
end Process_Statements_For_Controlled_Objects;
----------------------
-- Remove_Init_Call --
----------------------
function Remove_Init_Call
(Var : Entity_Id;
Rep_Clause : Node_Id) return Node_Id
is
Par : constant Node_Id := Parent (Var);
Typ : constant Entity_Id := Etype (Var);
Init_Proc : Entity_Id;
-- Initialization procedure for Typ
function Find_Init_Call_In_List (From : Node_Id) return Node_Id;
-- Look for init call for Var starting at From and scanning the
-- enclosing list until Rep_Clause or the end of the list is reached.
----------------------------
-- Find_Init_Call_In_List --
----------------------------
function Find_Init_Call_In_List (From : Node_Id) return Node_Id is
Init_Call : Node_Id;
begin
Init_Call := From;
while Present (Init_Call) and then Init_Call /= Rep_Clause loop
if Nkind (Init_Call) = N_Procedure_Call_Statement
and then Is_Entity_Name (Name (Init_Call))
and then Entity (Name (Init_Call)) = Init_Proc
then
return Init_Call;
end if;
Next (Init_Call);
end loop;
return Empty;
end Find_Init_Call_In_List;
Init_Call : Node_Id;
-- Start of processing for Find_Init_Call
begin
if Present (Initialization_Statements (Var)) then
Init_Call := Initialization_Statements (Var);
Set_Initialization_Statements (Var, Empty);
elsif not Has_Non_Null_Base_Init_Proc (Typ) then
-- No init proc for the type, so obviously no call to be found
return Empty;
else
-- We might be able to handle other cases below by just properly
-- setting Initialization_Statements at the point where the init proc
-- call is generated???
Init_Proc := Base_Init_Proc (Typ);
-- First scan the list containing the declaration of Var
Init_Call := Find_Init_Call_In_List (From => Next (Par));
-- If not found, also look on Var's freeze actions list, if any,
-- since the init call may have been moved there (case of an address
-- clause applying to Var).
if No (Init_Call) and then Present (Freeze_Node (Var)) then
Init_Call :=
Find_Init_Call_In_List (First (Actions (Freeze_Node (Var))));
end if;
-- If the initialization call has actuals that use the secondary
-- stack, the call may have been wrapped into a temporary block, in
-- which case the block itself has to be removed.
if No (Init_Call) and then Nkind (Next (Par)) = N_Block_Statement then
declare
Blk : constant Node_Id := Next (Par);
begin
if Present
(Find_Init_Call_In_List
(First (Statements (Handled_Statement_Sequence (Blk)))))
then
Init_Call := Blk;
end if;
end;
end if;
end if;
if Present (Init_Call) then
Remove (Init_Call);
end if;
return Init_Call;
end Remove_Init_Call;
-------------------------
-- Remove_Side_Effects --
-------------------------

16
gcc/ada/exp_util.ads
View file

@ -379,14 +379,6 @@ package Exp_Util is
-- declarations and/or allocations when the type is indefinite (including
-- class-wide).
function Find_Init_Call
(Var : Entity_Id;
Rep_Clause : Node_Id) return Node_Id;
-- Look for init_proc call for variable Var, either among declarations
-- between that of Var and a subsequent Rep_Clause applying to Var, or
-- in the list of freeze actions associated with Var, and if found, return
-- that call node.
function Find_Interface_ADT
(T : Entity_Id;
Iface : Entity_Id) return Elmt_Id;
@ -723,6 +715,14 @@ package Exp_Util is
-- statements looking for declarations of controlled objects. If at least
-- one such object is found, wrap the statement list in a block.
function Remove_Init_Call
(Var : Entity_Id;
Rep_Clause : Node_Id) return Node_Id;
-- Look for init_proc call or aggregate initialization statements for
-- variable Var, either among declarations between that of Var and a
-- subsequent Rep_Clause applying to Var, or in the list of freeze actions
-- associated with Var, and if found, remove and return that call node.
procedure Remove_Side_Effects
(Exp : Node_Id;
Name_Req : Boolean := False;

25
gcc/ada/freeze.adb
View file

@ -3344,6 +3344,31 @@ package body Freeze is
then
Layout_Object (E);
end if;
-- If initialization statements were captured in an expression
-- with actions with null expression, and the object does not
-- have delayed freezing, move them back now directly within the
-- enclosing statement sequence.
if Ekind_In (E, E_Constant, E_Variable)
and then not Has_Delayed_Freeze (E)
then
declare
Init_Stmts : constant Node_Id :=
Initialization_Statements (E);
begin
if Present (Init_Stmts)
and then Nkind (Init_Stmts) = N_Expression_With_Actions
and then Nkind (Expression (Init_Stmts))
= N_Null_Statement
then
Insert_List_Before (Init_Stmts, Actions (Init_Stmts));
Remove (Init_Stmts);
Set_Initialization_Statements (E, Empty);
end if;
end;
end if;
end if;
-- Case of a type or subtype being frozen

20
gcc/ada/sem_ch13.adb
View file

@ -2903,11 +2903,25 @@ package body Sem_Ch13 is
-- before its definition.
declare
Init_Call : constant Node_Id := Find_Init_Call (U_Ent, N);
Init_Call : constant Node_Id :=
Remove_Init_Call (U_Ent, N);
begin
if Present (Init_Call) then
Remove (Init_Call);
Append_Freeze_Action (U_Ent, Init_Call);
-- If the init call is an expression with actions with
-- null expression, just extract the actions.
if Nkind (Init_Call) = N_Expression_With_Actions
and then Nkind (Expression (Init_Call))
= N_Null_Statement
then
Append_Freeze_Actions (U_Ent, Actions (Init_Call));
-- General case: move Init_Call to freeze actions
else
Append_Freeze_Action (U_Ent, Init_Call);
end if;
end if;
end;

16
gcc/ada/sem_ch3.adb
View file

@ -3171,14 +3171,9 @@ package body Sem_Ch3 is
Set_Has_Completion (Id);
end if;
-- Set kind (expansion of E may need it) and type now, and resolve.
-- Type might be overridden later on.
if Constant_Present (N) then
Set_Ekind (Id, E_Constant);
else
Set_Ekind (Id, E_Variable);
end if;
-- Set type and resolve (type may be overridden later on). Note:
-- Ekind (Id) must still be E_Void at this point so that incorrect
-- early usage within E is properly diagnosed.
Set_Etype (Id, T);
Resolve (E, T);
@ -3520,12 +3515,11 @@ package body Sem_Ch3 is
Set_Never_Set_In_Source (Id, True);
-- Now establish the proper kind (if not already set) and type of the
-- object.
-- Now establish the proper kind and type of the object
if Constant_Present (N) then
Set_Ekind (Id, E_Constant);
Set_Is_True_Constant (Id, True);
Set_Ekind (Id, E_Constant);
else
Set_Ekind (Id, E_Variable);

20
gcc/ada/sinfo.ads
View file

@ -7020,15 +7020,10 @@ package Sinfo is
-- a subexpression, whose value is the value of the Expression after
-- executing all the actions.
-- Note: if the actions contain declarations, then these declarations
-- may be referenced within the expression. It is thus appropriate for
-- the back-end to create a scope that encompasses the construct (any
-- declarations within the actions will definitely not be referenced
-- once elaboration of the construct is completed).
-- But we rely on freeze nodes appearing in actions being elaborated in
-- the enclosing scope (see Exp_Aggr.Collect_Initialization_
-- Statements)???
-- If the actions contain declarations, then these declarations may
-- be referenced within the expression. However note that there is
-- no proper scope associated with the expression-with-action, so the
-- back-end will elaborate them in the context of the enclosing scope.
-- Sprint syntax: do
-- action;
@ -7046,7 +7041,10 @@ package Sinfo is
-- never have created this node if there weren't some actions.
-- Note: Expression may be a Null_Statement, in which case the
-- N_Expression_With_Actions has type Standard_Void_Type.
-- N_Expression_With_Actions has type Standard_Void_Type. However some
-- backends do not support such expression-with-actions occurring
-- outside of a proper (non-void) expression, so this should just be
-- used as an intermediate representation within the front-end.
--------------------
-- Free Statement --
@ -7183,7 +7181,7 @@ package Sinfo is
-- the exception to be raised (i.e. it is equivalent to a raise
-- statement that raises the corresponding exception). This use
-- is distinguished by the fact that the Etype in this case is
-- Standard_Void_Type, In the subexpression case, the Etype is the
-- Standard_Void_Type; in the subexpression case, the Etype is the
-- same as the type of the subexpression which it replaces.
-- If Condition is empty, then the raise is unconditional. If the