Skip to content

R
riscv-gcc-1
Commit 24778dbb by Arnaud Charlet
Options

[multiple changes] 

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch7.adb (Swap_Private_Dependents): New internal routine
	to Install_Private_Declarations, to make the installation of
	private dependents recursive in the presence of child units.
	* sem_ch3.adb (Build_Discriminated_Subtype): Initialize properly
	the Private_Dependents of a private subtype.

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

	* exp_attr.adb (Expand_Loop_Entry_Attribute): Update the
	retrieval of the block declarations.
	* par-ch4.adb (P_Name): Let the name parsing machinery create
	a sequence of nested indexed components for attribute Loop_Entry.
	* sem_attr.adb (Analyze_Attribute): Add local constant
	Context. Reimplement part of the analysis of attribute Loop_Entry.
	(Convert_To_Indexed_Component): Removed.
	* sem_ch4.adb (Analyze_Indexed_Component_Form): Do not analyze
	an indexed component after it has been rewritten into attribute
	Loop_Entry.

From-SVN: r198240
parent 8a8ac7e3
Showing with 172 additions and 118 deletions
gcc/ada/ChangeLog
2013-04-24 Ed Schonberg <schonberg@adacore.com>
* sem_ch7.adb (Swap_Private_Dependents): New internal routine
to Install_Private_Declarations, to make the installation of
private dependents recursive in the presence of child units.
* sem_ch3.adb (Build_Discriminated_Subtype): Initialize properly
the Private_Dependents of a private subtype.
2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb (Expand_Loop_Entry_Attribute): Update the
retrieval of the block declarations.
* par-ch4.adb (P_Name): Let the name parsing machinery create
a sequence of nested indexed components for attribute Loop_Entry.
* sem_attr.adb (Analyze_Attribute): Add local constant
Context. Reimplement part of the analysis of attribute Loop_Entry.
(Convert_To_Indexed_Component): Removed.
* sem_ch4.adb (Analyze_Indexed_Component_Form): Do not analyze
an indexed component after it has been rewritten into attribute
Loop_Entry.
2013-04-24 Yannick Moy <moy@adacore.com>
* snames.ads-tmpl: Minor change to list
......
gcc/ada/exp_attr.adb
......@@ -782,7 +782,15 @@ package body Exp_Attr is
-- 'Loop_Entry attribute. Retrieve the declarative list of the block.
if Has_Loop_Entry_Attributes (Loop_Id) then
Decls := Declarations (Parent (Parent (Loop_Stmt)));
if Nkind (Loop_Stmt) = N_Block_Statement then
Decls := Declarations (Loop_Stmt);
else
-- What is going on here??? comments/assertions needed to explain
-- the assumption being made about the tree???
Decls := Declarations (Parent (Parent (Loop_Stmt)));
end if;
Result := Empty;
-- Transform the loop into a conditional block
......
gcc/ada/par-ch4.adb
......@@ -698,25 +698,16 @@ package body Ch4 is
if Token = Tok_Arrow then
Error_Msg
("expect identifier in parameter association",
Sloc (Expr_Node));
("expect identifier in parameter association", Sloc (Expr_Node));
Scan; -- past arrow
elsif not Comma_Present then
T_Right_Paren;
-- Do not convert Prefix'Loop_Entry (Expr1, ..., ExprN) into an
-- indexed component now. Let the analysis determine whether the
-- attribute is legal and perform the transformation if needed.
if Attr_Name = Name_Loop_Entry then
Set_Expressions (Name_Node, Arg_List);
else
Prefix_Node := Name_Node;
Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
Set_Prefix (Name_Node, Prefix_Node);
Set_Expressions (Name_Node, Arg_List);
end if;
Prefix_Node := Name_Node;
Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
Set_Prefix (Name_Node, Prefix_Node);
Set_Expressions (Name_Node, Arg_List);
goto Scan_Name_Extension;
end if;
......
gcc/ada/sem_attr.adb
......@@ -2136,20 +2136,6 @@ package body Sem_Attr is
E1 := Empty;
E2 := Empty;
-- Do not analyze the expressions of attribute Loop_Entry. Depending on
-- the number of arguments and/or the nature of the first argument, the
-- whole attribute reference may be rewritten into an indexed component.
-- In the case of two or more arguments, the expressions are analyzed
-- when the indexed component is analyzed, otherwise the sole argument
-- is preanalyzed to determine whether it is a loop name.
elsif Aname = Name_Loop_Entry then
E1 := First (Exprs);
if Present (E1) then
E2 := Next (E1);
end if;
else
E1 := First (Exprs);
Analyze (E1);
......@@ -3641,11 +3627,6 @@ package body Sem_Attr is
-- Inspect the prefix for any uses of entities declared within the
-- related loop. Loop_Id denotes the loop identifier.
procedure Convert_To_Indexed_Component;
-- Transform the attribute reference into an indexed component where
-- the prefix is Prefix'Loop_Entry and the expressions are associated
-- with the indexed component.
--------------------------------
-- Check_References_In_Prefix --
--------------------------------
......@@ -3712,27 +3693,9 @@ package body Sem_Attr is
Check_References (P);
end Check_References_In_Prefix;
----------------------------------
-- Convert_To_Indexed_Component --
----------------------------------
procedure Convert_To_Indexed_Component is
New_Loop_Entry : constant Node_Id := Relocate_Node (N);
begin
-- The new Loop_Entry loses its arguments. They will be converted
-- into the expressions of the indexed component.
Set_Expressions (New_Loop_Entry, No_List);
Rewrite (N,
Make_Indexed_Component (Loc,
Prefix => New_Loop_Entry,
Expressions => Exprs));
end Convert_To_Indexed_Component;
-- Local variables
Context : constant Node_Id := Parent (N);
Enclosing_Loop : Node_Id;
In_Loop_Assertion : Boolean := False;
Loop_Id : Entity_Id := Empty;
......@@ -3742,47 +3705,77 @@ package body Sem_Attr is
-- Start of processing for Loop_Entry
begin
S14_Attribute;
-- Attribute 'Loop_Entry may appear in several flavors:
-- The attribute reference appears as
-- Prefix'Loop_Entry (Expr1, Expr2, ... ExprN)
-- * Prefix'Loop_Entry - in this form, the attribute applies to the
-- nearest enclosing loop.
-- In this case, the loop name is omitted and the arguments are part
-- of an indexed component. Transform the whole attribute reference
-- to reflect this scenario.
-- * Prefix'Loop_Entry (Expr) - depending on what Expr denotes, the
-- attribute may be related to a loop denoted by label Expr or
-- the prefix may denote an array object and Expr may act as an
-- indexed component.
if Present (E2) then
Convert_To_Indexed_Component;
Analyze (N);
return;
-- * Prefix'Loop_Entry (Expr1, ..., ExprN) - the attribute applies
-- to the nearest enclosing loop, all expressions are part of
-- an indexed component.
-- The attribute reference appears as
-- Prefix'Loop_Entry (Loop_Name)
-- or
-- Prefix'Loop_Entry (Expr1)
-- * Prefix'Loop_Entry (Expr) (...) (...) - depending on what Expr
-- denotes, the attribute may be related to a loop denoted by
-- label Expr or the prefix may denote a multidimensional array
-- array object and Expr along with the rest of the expressions
-- may act as indexed components.
-- Depending on what Expr1 resolves to, either rewrite the reference
-- into an indexed component or continue with the analysis.
-- Regardless of variations, the attribute reference does not have an
-- expression list. Instead, all available expressions are stored as
-- indexed components.
elsif Present (E1) then
S14_Attribute;
-- Do not expand the argument as it may have side effects. Simply
-- preanalyze to determine whether it is a loop or something else.
-- When the attribute is part of an indexed component, find the first
-- expression as it will determine the semantics of 'Loop_Entry.
Preanalyze_And_Resolve (E1);
if Nkind (Context) = N_Indexed_Component then
E1 := First (Expressions (Context));
E2 := Next (E1);
if Is_Entity_Name (E1)
and then Present (Entity (E1))
and then Ekind (Entity (E1)) = E_Loop
then
Loop_Id := Entity (E1);
-- The attribute reference appears in the following form:
-- Prefix'Loop_Entry (Exp1, Expr2, ..., ExprN) [(...)]
-- In this case, the loop name is omitted and no rewriting is
-- required.
if Present (E2) then
null;
-- The form of the attribute is:
-- Prefix'Loop_Entry (Expr) [(...)]
-- The argument is not a loop name
-- If Expr denotes a loop entry, the whole attribute and indexed
-- component will have to be rewritten to reflect this relation.
else
Convert_To_Indexed_Component;
Analyze (N);
return;
pragma Assert (Present (E1));
-- Do not expand the expression as it may have side effects.
-- Simply preanalyze to determine whether it is a loop name or
-- something else.
Preanalyze_And_Resolve (E1);
if Is_Entity_Name (E1)
and then Present (Entity (E1))
and then Ekind (Entity (E1)) = E_Loop
then
Loop_Id := Entity (E1);
-- Transform the attribute and enclosing indexed component
Set_Expressions (N, Expressions (Context));
Rewrite (Context, N);
Set_Etype (Context, P_Type);
end if;
end if;
end if;
......
gcc/ada/sem_ch3.adb
......@@ -8659,6 +8659,10 @@ package body Sem_Ch3 is
Set_Known_To_Have_Preelab_Init
(Def_Id, Known_To_Have_Preelab_Init (T));
-- private subtypes may have private dependents.
Set_Private_Dependents (Def_Id, New_Elmt_List);
elsif Is_Class_Wide_Type (T) then
Set_Ekind (Def_Id, E_Class_Wide_Subtype);
......
gcc/ada/sem_ch4.adb
......@@ -2388,12 +2388,20 @@ package body Sem_Ch4 is
Analyze (P);
-- If P is an explicit dereference whose prefix is of a remote access-
-- to-subprogram type, then N has already been rewritten as a subprogram
-- call and analyzed.
if Nkind (N) in N_Subprogram_Call then
return;
-- If P is an explicit dereference whose prefix is of a
-- remote access-to-subprogram type, then N has already
-- been rewritten as a subprogram call and analyzed.
-- When the prefix is attribute 'Loop_Entry and the sole expression of
-- the indexed component denotes a loop name, the indexed form is turned
-- into an attribute reference.
elsif Nkind (N) = N_Attribute_Reference
and then Attribute_Name (N) = Name_Loop_Entry
then
return;
end if;
......
gcc/ada/sem_ch7.adb
......@@ -1812,9 +1812,63 @@ package body Sem_Ch7 is
procedure Install_Private_Declarations (P : Entity_Id) is
Id : Entity_Id;
Priv_Elmt : Elmt_Id;
Priv : Entity_Id;
Full : Entity_Id;
Priv_Deps : Elist_Id;
procedure Swap_Private_Dependents (Priv_Deps : Elist_Id);
-- When the full view of a private type is made available, we do the
-- same for its private dependents under proper visibility conditions.
-- When compiling a grand-chid unit this needs to be done recursively.
procedure Swap_Private_Dependents (Priv_Deps : Elist_Id) is
Deps : Elist_Id;
Priv : Entity_Id;
Priv_Elmt : Elmt_Id;
Is_Priv : Boolean;
begin
Priv_Elmt := First_Elmt (Priv_Deps);
while Present (Priv_Elmt) loop
Priv := Node (Priv_Elmt);
-- Before the exchange, verify that the presence of the
-- Full_View field. It will be empty if the entity has already
-- been installed due to a previous call.
if Present (Full_View (Priv))
and then Is_Visible_Dependent (Priv)
then
if Is_Private_Type (Priv) then
Deps := Private_Dependents (Priv);
Is_Priv := True;
else
Is_Priv := False;
end if;
-- For each subtype that is swapped, we also swap the
-- reference to it in Private_Dependents, to allow access
-- to it when we swap them out in End_Package_Scope.
Replace_Elmt (Priv_Elmt, Full_View (Priv));
Exchange_Declarations (Priv);
Set_Is_Immediately_Visible
(Priv, In_Open_Scopes (Scope (Priv)));
Set_Is_Potentially_Use_Visible
(Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt)));
-- Within a child unit, recurse.
if Is_Priv
and then Is_Child_Unit (Cunit_Entity (Current_Sem_Unit))
then
Swap_Private_Dependents (Deps);
end if;
end if;
Next_Elmt (Priv_Elmt);
end loop;
end Swap_Private_Dependents;
begin
-- First exchange declarations for private types, so that the full
......@@ -1869,36 +1923,10 @@ package body Sem_Ch7 is
end if;
end if;
Priv_Elmt := First_Elmt (Private_Dependents (Id));
Priv_Deps := Private_Dependents (Id);
Exchange_Declarations (Id);
Set_Is_Immediately_Visible (Id);
while Present (Priv_Elmt) loop
Priv := Node (Priv_Elmt);
-- Before the exchange, verify that the presence of the
-- Full_View field. It will be empty if the entity has already
-- been installed due to a previous call.
if Present (Full_View (Priv))
and then Is_Visible_Dependent (Priv)
then
-- For each subtype that is swapped, we also swap the
-- reference to it in Private_Dependents, to allow access
-- to it when we swap them out in End_Package_Scope.
Replace_Elmt (Priv_Elmt, Full_View (Priv));
Exchange_Declarations (Priv);
Set_Is_Immediately_Visible
(Priv, In_Open_Scopes (Scope (Priv)));
Set_Is_Potentially_Use_Visible
(Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt)));
end if;
Next_Elmt (Priv_Elmt);
end loop;
Swap_Private_Dependents (Priv_Deps);
end if;
Next_Entity (Id);
......@@ -2035,12 +2063,13 @@ package body Sem_Ch7 is
if Ada_Version < Ada_2012 then
Enter_Name (Id);
-- Ada 2012 (AI05-0162): Enter the name in the current scope handling
-- private type that completes an incomplete type.
-- Ada 2012 (AI05-0162): Enter the name in the current scope. Note that
-- there may be an incomplete previous view.
else
declare
Prev : Entity_Id;
begin
Prev := Find_Type_Name (N);
pragma Assert (Prev = Id
......@@ -2093,7 +2122,7 @@ package body Sem_Ch7 is
-- Create a class-wide type with the same attributes
Make_Class_Wide_Type (Id);
Make_Class_Wide_Type (Id);
elsif Abstract_Present (Def) then
Error_Msg_N ("only a tagged type can be abstract", N);
......
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