From 24778dbb9a732e8c626807b1a5f4bfe8cec09a58 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 24 Apr 2013 16:38:50 +0200 Subject: [PATCH] [multiple changes] 2013-04-24 Ed Schonberg * 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 * 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 --- gcc/ada/ChangeLog | 21 +++++++++ gcc/ada/exp_attr.adb | 10 +++- gcc/ada/par-ch4.adb | 19 ++------ gcc/ada/sem_attr.adb | 127 ++++++++++++++++++++++++--------------------------- gcc/ada/sem_ch3.adb | 4 ++ gcc/ada/sem_ch4.adb | 14 ++++-- gcc/ada/sem_ch7.adb | 95 +++++++++++++++++++++++++------------- 7 files changed, 172 insertions(+), 118 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 34a91d1..345f9d2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2013-04-24 Ed Schonberg + + * 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 + + * 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 * snames.ads-tmpl: Minor change to list diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index c206218..f904707 100644 --- a/gcc/ada/exp_attr.adb +++ b/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 diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index f0cfa35..e1e634a 100644 --- a/gcc/ada/par-ch4.adb +++ b/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; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index fc1ace2..30509dc 100644 --- a/gcc/ada/sem_attr.adb +++ b/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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index af2cc23..8e874af 100644 --- a/gcc/ada/sem_ch3.adb +++ b/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); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index e78ce33..ae69805 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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; diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index f8e2799..c21874d 100644 --- a/gcc/ada/sem_ch7.adb +++ b/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); -- 2.7.4