Skip to content

R
riscv-gcc-1
Commit 0592046e by Arnaud Charlet
Options

[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
parent 880dabb5
Showing with 92 additions and 37 deletions
gcc/ada/ChangeLog
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.
......
gcc/ada/sem_ch3.adb
......@@ -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 ???
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);
-- 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.
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);
......
gcc/ada/sem_ch5.adb
......@@ -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;
......
gcc/ada/sem_prag.adb
......@@ -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
......
gcc/ada/sem_res.adb
......@@ -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;
-------------------
......
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