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