[multiple changes]
2010-10-26 Javier Miranda <miranda@adacore.com> * sem_prag.adb (Process_Import_Or_Interface): Skip primitives of interface types when processing all the entities in the homonym chain that are declared in the same declarative part. 2010-10-26 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Process_Range_In_Decl): If the range is part of a quantified expression, the insertion point for range checks will be arbitrarily far in the tree. * sem_ch5.adb (One_Bound): Use Insert_Actions for the declaration of the temporary that holds the value of the bounds. * sem_res.adb (Resolve_Quantified_Expressions): Disable expansion of condition until the full expression is expanded. From-SVN: r165957
This commit is contained in:
parent
880dabb586
commit
0592046e23
|
@ -1,3 +1,19 @@
|
|||
2010-10-26 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_prag.adb (Process_Import_Or_Interface): Skip primitives of
|
||||
interface types when processing all the entities in the homonym chain
|
||||
that are declared in the same declarative part.
|
||||
|
||||
2010-10-26 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Process_Range_In_Decl): If the range is part of a
|
||||
quantified expression, the insertion point for range checks will be
|
||||
arbitrarily far in the tree.
|
||||
* sem_ch5.adb (One_Bound): Use Insert_Actions for the declaration of
|
||||
the temporary that holds the value of the bounds.
|
||||
* sem_res.adb (Resolve_Quantified_Expressions): Disable expansion of
|
||||
condition until the full expression is expanded.
|
||||
|
||||
2010-10-26 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* opt.ads: Comment fix.
|
||||
|
|
|
@ -17627,10 +17627,10 @@ package body Sem_Ch3 is
|
|||
Check_List : List_Id := Empty_List;
|
||||
R_Check_Off : Boolean := False)
|
||||
is
|
||||
Lo, Hi : Node_Id;
|
||||
R_Checks : Check_Result;
|
||||
Type_Decl : Node_Id;
|
||||
Def_Id : Entity_Id;
|
||||
Lo, Hi : Node_Id;
|
||||
R_Checks : Check_Result;
|
||||
Insert_Node : Node_Id;
|
||||
Def_Id : Entity_Id;
|
||||
|
||||
begin
|
||||
Analyze_And_Resolve (R, Base_Type (T));
|
||||
|
@ -17738,32 +17738,43 @@ package body Sem_Ch3 is
|
|||
if not R_Check_Off then
|
||||
R_Checks := Get_Range_Checks (R, T);
|
||||
|
||||
-- Look up tree to find an appropriate insertion point.
|
||||
-- This seems really junk code, and very brittle, couldn't
|
||||
-- we just use an insert actions call of some kind ???
|
||||
-- Look up tree to find an appropriate insertion point. We
|
||||
-- can't just use insert_actions because later processing
|
||||
-- depends on the insertion node. Prior to Ada2012 the
|
||||
-- insertion point could only be a declaration or a loop, but
|
||||
-- quantified expressions can appear within any context in an
|
||||
-- expression, and the insertion point can be any statement,
|
||||
-- pragma, or declaration.
|
||||
|
||||
Type_Decl := Parent (R);
|
||||
while Present (Type_Decl) and then not
|
||||
(Nkind_In (Type_Decl, N_Full_Type_Declaration,
|
||||
N_Subtype_Declaration,
|
||||
N_Loop_Statement,
|
||||
N_Task_Type_Declaration)
|
||||
or else
|
||||
Nkind_In (Type_Decl, N_Single_Task_Declaration,
|
||||
N_Protected_Type_Declaration,
|
||||
N_Single_Protected_Declaration))
|
||||
loop
|
||||
Type_Decl := Parent (Type_Decl);
|
||||
Insert_Node := Parent (R);
|
||||
while Present (Insert_Node) loop
|
||||
exit when
|
||||
Nkind (Insert_Node) in N_Declaration
|
||||
and then
|
||||
not Nkind_In
|
||||
(Insert_Node, N_Component_Declaration,
|
||||
N_Loop_Parameter_Specification,
|
||||
N_Function_Specification,
|
||||
N_Procedure_Specification);
|
||||
|
||||
exit when Nkind (Insert_Node) in N_Later_Decl_Item
|
||||
or else Nkind (Insert_Node) in
|
||||
N_Statement_Other_Than_Procedure_Call
|
||||
or else Nkind_In (Insert_Node, N_Procedure_Call_Statement,
|
||||
N_Pragma);
|
||||
|
||||
Insert_Node := Parent (Insert_Node);
|
||||
end loop;
|
||||
|
||||
-- Why would Type_Decl not be present??? Without this test,
|
||||
-- short regression tests fail.
|
||||
|
||||
if Present (Type_Decl) then
|
||||
if Present (Insert_Node) then
|
||||
|
||||
-- Case of loop statement (more comments ???)
|
||||
-- Case of loop statement. Verify that the range is part
|
||||
-- of the subtype indication of the iteration scheme.
|
||||
|
||||
if Nkind (Type_Decl) = N_Loop_Statement then
|
||||
if Nkind (Insert_Node) = N_Loop_Statement then
|
||||
declare
|
||||
Indic : Node_Id;
|
||||
|
||||
|
@ -17780,18 +17791,20 @@ package body Sem_Ch3 is
|
|||
|
||||
Insert_Range_Checks
|
||||
(R_Checks,
|
||||
Type_Decl,
|
||||
Insert_Node,
|
||||
Def_Id,
|
||||
Sloc (Type_Decl),
|
||||
Sloc (Insert_Node),
|
||||
R,
|
||||
Do_Before => True);
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- All other cases (more comments ???)
|
||||
-- Insertion before a declaration. If the declaration
|
||||
-- includes discriminants, the list of applicable checks
|
||||
-- is given by the caller.
|
||||
|
||||
else
|
||||
Def_Id := Defining_Identifier (Type_Decl);
|
||||
elsif Nkind (Insert_Node) in N_Declaration then
|
||||
Def_Id := Defining_Identifier (Insert_Node);
|
||||
|
||||
if (Ekind (Def_Id) = E_Record_Type
|
||||
and then Depends_On_Discriminant (R))
|
||||
|
@ -17800,18 +17813,29 @@ package body Sem_Ch3 is
|
|||
and then Has_Discriminants (Def_Id))
|
||||
then
|
||||
Append_Range_Checks
|
||||
(R_Checks, Check_List, Def_Id, Sloc (Type_Decl), R);
|
||||
(R_Checks,
|
||||
Check_List, Def_Id, Sloc (Insert_Node), R);
|
||||
|
||||
else
|
||||
Insert_Range_Checks
|
||||
(R_Checks, Type_Decl, Def_Id, Sloc (Type_Decl), R);
|
||||
(R_Checks,
|
||||
Insert_Node, Def_Id, Sloc (Insert_Node), R);
|
||||
|
||||
end if;
|
||||
|
||||
-- Insertion before a statement. Range appears in the
|
||||
-- context of a quantified expression. Insertion will
|
||||
-- take place when expression is expanded.
|
||||
|
||||
else
|
||||
null;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Case of other than an explicit N_Range node
|
||||
|
||||
elsif Expander_Active then
|
||||
Get_Index_Bounds (R, Lo, Hi);
|
||||
Force_Evaluation (Lo);
|
||||
|
|
|
@ -1538,8 +1538,11 @@ package body Sem_Ch5 is
|
|||
Object_Definition => New_Occurrence_Of (Typ, Loc),
|
||||
Expression => Relocate_Node (Original_Bound));
|
||||
|
||||
Insert_Before (Parent (N), Decl);
|
||||
Analyze (Decl);
|
||||
-- Insert declaration at proper place. If loop comes from an
|
||||
-- enclosing quantified expression, the insertion point is
|
||||
-- arbitrarily far up in the tree.
|
||||
|
||||
Insert_Action (Parent (N), Decl);
|
||||
Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc));
|
||||
return Expression (Decl);
|
||||
end if;
|
||||
|
|
|
@ -3928,6 +3928,14 @@ package body Sem_Prag is
|
|||
then
|
||||
null;
|
||||
|
||||
-- The pragma does not apply to primitives of interfaces
|
||||
|
||||
elsif Is_Dispatching_Operation (Def_Id)
|
||||
and then Present (Find_Dispatching_Type (Def_Id))
|
||||
and then Is_Interface (Find_Dispatching_Type (Def_Id))
|
||||
then
|
||||
null;
|
||||
|
||||
-- Verify that the homonym is in the same declarative part (not
|
||||
-- just the same scope).
|
||||
|
||||
|
@ -4047,10 +4055,10 @@ package body Sem_Prag is
|
|||
and then C = Convention_CPP
|
||||
then
|
||||
-- Types treated as CPP classes are treated as limited, but we
|
||||
-- don't require them to be declared this way. A warning is
|
||||
-- issued to encourage the user to declare them as limited.
|
||||
-- This is not an error, for compatibility reasons, because
|
||||
-- these types have been supported this way for some time.
|
||||
-- don't require them to be declared this way. A warning is issued
|
||||
-- to encourage the user to declare them as limited. This is not
|
||||
-- an error, for compatibility reasons, because these types have
|
||||
-- been supported this way for some time.
|
||||
|
||||
if not Is_Limited_Type (Def_Id) then
|
||||
Error_Msg_N
|
||||
|
|
|
@ -7809,9 +7809,13 @@ package body Sem_Res is
|
|||
procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
|
||||
begin
|
||||
-- The loop structure is already resolved during its analysis, only the
|
||||
-- resolution of the condition needs to be done.
|
||||
-- resolution of the condition needs to be done. Expansion is disabled
|
||||
-- so that checks and other generated code are inserted in the tree
|
||||
-- after expression has been rewritten as a loop.
|
||||
|
||||
Expander_Mode_Save_And_Set (False);
|
||||
Resolve (Condition (N), Typ);
|
||||
Expander_Mode_Restore;
|
||||
end Resolve_Quantified_Expression;
|
||||
|
||||
-------------------
|
||||
|
|
Loading…
Reference in New Issue