+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
-- '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
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;
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);
-- 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 --
--------------------------------
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;
-- 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;
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);
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;
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
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);
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
-- 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);
projects / gcc.git / commitdiff