Skip to content

R
riscv-gcc-1
Commit 5f3f175d by Arnaud Charlet
Options

[multiple changes] 

2009-10-28  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb (Expand_N_Type_Conversion): Perform Integer promotion for
	the operand of the unary minus and ABS operators.

	* sem_type.adb (Covers): A concurrent type and its corresponding record
	type are compatible.
	* exp_attr.adb (Expand_N_Attribute_Reference): Do not rewrite a 'Access
	attribute reference for the current instance of a protected type while
	analyzing an access discriminant constraint in a component definition.
	Such a reference is handled in the corresponding record's init proc,
	while initializing the constrained component.
	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): When creating the
	corresponding record type, propagate components'
	Has_Per_Object_Constraint flag.
	* exp_ch3.adb (Build_Init_Procedure.Build_Init_Statements):
	For a concurrent type, set up concurrent aspects before initializing
	components with a per object constrain, because they may be controlled,
	and their initialization may call entries or protected subprograms of
	the enclosing concurrent object.

2009-10-28  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Add_If_Not_In_List): New subprogram, for better sharing
	of code.
	(Find_Source_Dirs): resolve links if Opt.Follow_Links_For_Dirs when
	processing the directories specified explicitly in the project file.

From-SVN: r153657
parent b87971f3
Showing with 145 additions and 90 deletions
gcc/ada/ChangeLog
2009-10-28 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb (Expand_N_Type_Conversion): Perform Integer promotion for
the operand of the unary minus and ABS operators.
* sem_type.adb (Covers): A concurrent type and its corresponding record
type are compatible.
* exp_attr.adb (Expand_N_Attribute_Reference): Do not rewrite a 'Access
attribute reference for the current instance of a protected type while
analyzing an access discriminant constraint in a component definition.
Such a reference is handled in the corresponding record's init proc,
while initializing the constrained component.
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): When creating the
corresponding record type, propagate components'
Has_Per_Object_Constraint flag.
* exp_ch3.adb (Build_Init_Procedure.Build_Init_Statements):
For a concurrent type, set up concurrent aspects before initializing
components with a per object constrain, because they may be controlled,
and their initialization may call entries or protected subprograms of
the enclosing concurrent object.
2009-10-28 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Add_If_Not_In_List): New subprogram, for better sharing
of code.
(Find_Source_Dirs): resolve links if Opt.Follow_Links_For_Dirs when
processing the directories specified explicitly in the project file.
2009-10-28 Robert Dewar <dewar@adacore.com>
* a-ztexio.adb, a-ztexio.ads, a-witeio.ads, a-witeio.adb,
......
gcc/ada/exp_attr.adb
......@@ -654,10 +654,20 @@ package body Exp_Attr is
Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
end if;
-- If prefix is a protected type name, this is a reference to
-- the current instance of the type.
if Is_Protected_Self_Reference (Pref) then
-- If prefix is a protected type name, this is a reference to the
-- current instance of the type. For a component definition, nothing
-- to do (expansion will occur in the init proc). In other contexts,
-- rewrite into reference to current instance.
if Is_Protected_Self_Reference (Pref)
and then not
(Nkind_In (Parent (N),
N_Index_Or_Discriminant_Constraint,
N_Discriminant_Association)
and then
Nkind (Parent (Parent (Parent (Parent (N)))))
= N_Component_Definition)
then
Rewrite (Pref, Concurrent_Ref (Pref));
Analyze (Pref);
end if;
......
gcc/ada/exp_ch3.adb
......@@ -2733,70 +2733,11 @@ package body Exp_Ch3 is
Next_Non_Pragma (Decl);
end loop;
if Per_Object_Constraint_Components then
-- Second pass: components with per-object constraints
Decl := First_Non_Pragma (Component_Items (Comp_List));
while Present (Decl) loop
Loc := Sloc (Decl);
Id := Defining_Identifier (Decl);
Typ := Etype (Id);
if Has_Access_Constraint (Id)
and then No (Expression (Decl))
then
if Has_Non_Null_Base_Init_Proc (Typ) then
Append_List_To (Statement_List,
Build_Initialization_Call (Loc,
Make_Selected_Component (Loc,
Prefix => Make_Identifier (Loc, Name_uInit),
Selector_Name => New_Occurrence_Of (Id, Loc)),
Typ,
In_Init_Proc => True,
Enclos_Type => Rec_Type,
Discr_Map => Discr_Map));
Clean_Task_Names (Typ, Proc_Id);
elsif Component_Needs_Simple_Initialization (Typ) then
Append_List_To (Statement_List,
Build_Assignment
(Id, Get_Simple_Init_Val (Typ, N, Esize (Id))));
end if;
end if;
Next_Non_Pragma (Decl);
end loop;
end if;
-- Process the variant part
if Present (Variant_Part (Comp_List)) then
Alt_List := New_List;
Variant := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
while Present (Variant) loop
Loc := Sloc (Variant);
Append_To (Alt_List,
Make_Case_Statement_Alternative (Loc,
Discrete_Choices =>
New_Copy_List (Discrete_Choices (Variant)),
Statements =>
Build_Init_Statements (Component_List (Variant))));
Next_Non_Pragma (Variant);
end loop;
-- The expression of the case statement which is a reference
-- to one of the discriminants is replaced by the appropriate
-- formal parameter of the initialization procedure.
Append_To (Statement_List,
Make_Case_Statement (Loc,
Expression =>
New_Reference_To (Discriminal (
Entity (Name (Variant_Part (Comp_List)))), Loc),
Alternatives => Alt_List));
end if;
-- Set up tasks and protected object support. This needs to be done
-- before any component with a per-object access discriminant
-- constraint, or any variant part (which may contain such
-- components) is initialized, because the initialization of these
-- components may reference the enclosing concurrent object.
-- For a task record type, add the task create call and calls
-- to bind any interrupt (signal) entries.
......@@ -2898,6 +2839,71 @@ package body Exp_Ch3 is
end if;
end if;
if Per_Object_Constraint_Components then
-- Second pass: components with per-object constraints
Decl := First_Non_Pragma (Component_Items (Comp_List));
while Present (Decl) loop
Loc := Sloc (Decl);
Id := Defining_Identifier (Decl);
Typ := Etype (Id);
if Has_Access_Constraint (Id)
and then No (Expression (Decl))
then
if Has_Non_Null_Base_Init_Proc (Typ) then
Append_List_To (Statement_List,
Build_Initialization_Call (Loc,
Make_Selected_Component (Loc,
Prefix => Make_Identifier (Loc, Name_uInit),
Selector_Name => New_Occurrence_Of (Id, Loc)),
Typ,
In_Init_Proc => True,
Enclos_Type => Rec_Type,
Discr_Map => Discr_Map));
Clean_Task_Names (Typ, Proc_Id);
elsif Component_Needs_Simple_Initialization (Typ) then
Append_List_To (Statement_List,
Build_Assignment
(Id, Get_Simple_Init_Val (Typ, N, Esize (Id))));
end if;
end if;
Next_Non_Pragma (Decl);
end loop;
end if;
-- Process the variant part
if Present (Variant_Part (Comp_List)) then
Alt_List := New_List;
Variant := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
while Present (Variant) loop
Loc := Sloc (Variant);
Append_To (Alt_List,
Make_Case_Statement_Alternative (Loc,
Discrete_Choices =>
New_Copy_List (Discrete_Choices (Variant)),
Statements =>
Build_Init_Statements (Component_List (Variant))));
Next_Non_Pragma (Variant);
end loop;
-- The expression of the case statement which is a reference
-- to one of the discriminants is replaced by the appropriate
-- formal parameter of the initialization procedure.
Append_To (Statement_List,
Make_Case_Statement (Loc,
Expression =>
New_Reference_To (Discriminal (
Entity (Name (Variant_Part (Comp_List)))), Loc),
Alternatives => Alt_List));
end if;
-- If no initializations when generated for component declarations
-- corresponding to this Statement_List, append a null statement
-- to the Statement_List to make it a valid Ada tree.
......
gcc/ada/exp_ch4.adb
......@@ -8056,27 +8056,25 @@ package body Exp_Ch4 is
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Expression => Relocate_Node (Right_Opnd (Operand)));
if Nkind (Operand) = N_Op_Minus then
Opnd := Make_Op_Minus (Loc, Right_Opnd => R);
Opnd := New_Op_Node (Nkind (Operand), Loc);
Set_Right_Opnd (Opnd, R);
else
if Nkind (Operand) in N_Binary_Op then
L :=
Make_Type_Conversion (Loc,
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Expression => Relocate_Node (Left_Opnd (Operand)));
Opnd := New_Op_Node (Nkind (Operand), Loc);
Set_Left_Opnd (Opnd, L);
Set_Right_Opnd (Opnd, R);
Set_Left_Opnd (Opnd, L);
end if;
Rewrite (N,
Make_Type_Conversion (Loc,
Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
Expression => Opnd));
Rewrite (N,
Make_Type_Conversion (Loc,
Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
Expression => Opnd));
Analyze_And_Resolve (N, Target_Type);
return;
end if;
Analyze_And_Resolve (N, Target_Type);
return;
end;
end if;
......@@ -9174,10 +9172,12 @@ package body Exp_Ch4 is
Root_Operand_Type = Base_Type (Standard_Short_Short_Integer))
-- Test for interesting operation, which includes addition,
-- division, exponentiation, multiplication, subtraction, and
-- unary negation.
-- division, exponentiation, multiplication, subtraction, absolute
-- value and unary negation. Unary "+" is omitted since it is a
-- no-op and thus can't overflow.
and then Nkind_In (Operand, N_Op_Add,
and then Nkind_In (Operand, N_Op_Abs,
N_Op_Add,
N_Op_Divide,
N_Op_Expon,
N_Op_Minus,
......
gcc/ada/exp_ch9.adb
......@@ -7821,20 +7821,23 @@ package body Exp_Ch9 is
declare
Old_Comp : constant Node_Id := Component_Definition (Priv);
Pent : constant Entity_Id := Defining_Identifier (Priv);
Oent : constant Entity_Id := Defining_Identifier (Priv);
New_Comp : Node_Id;
Nent : constant Entity_Id :=
Make_Defining_Identifier
(Sloc (Oent), Chars (Oent));
begin
if Present (Subtype_Indication (Old_Comp)) then
New_Comp :=
Make_Component_Definition (Sloc (Pent),
Make_Component_Definition (Sloc (Oent),
Aliased_Present => False,
Subtype_Indication =>
New_Copy_Tree (Subtype_Indication (Old_Comp),
Discr_Map));
else
New_Comp :=
Make_Component_Definition (Sloc (Pent),
Make_Component_Definition (Sloc (Oent),
Aliased_Present => False,
Access_Definition =>
New_Copy_Tree (Access_Definition (Old_Comp),
......@@ -7843,11 +7846,13 @@ package body Exp_Ch9 is
New_Priv :=
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Sloc (Pent), Chars (Pent)),
Defining_Identifier => Nent,
Component_Definition => New_Comp,
Expression => Expression (Priv));
Set_Has_Per_Object_Constraint (Nent,
Has_Per_Object_Constraint (Oent));
Append_To (Cdecls, New_Priv);
end;
......
gcc/ada/sem_type.adb
......@@ -791,7 +791,7 @@ package body Sem_Type is
or else Scope (T1) /= Scope (T2));
end if;
-- Literals are compatible with types in a given "class"
-- Literals are compatible with types in a given "class"
elsif (T2 = Universal_Integer and then Is_Integer_Type (T1))
or else (T2 = Universal_Real and then Is_Real_Type (T1))
......@@ -970,6 +970,12 @@ package body Sem_Type is
then
return Covers (Corresponding_Remote_Type (T2), T1);
elsif Is_Record_Type (T1) and then Is_Concurrent_Type (T2) then
return Covers (T1, Corresponding_Record_Type (T2));
elsif Is_Concurrent_Type (T1) and then Is_Record_Type (T2) then
return Covers (Corresponding_Record_Type (T1), T2);
elsif Ekind (T2) = E_Access_Attribute_Type
and then (Ekind (BT1) = E_General_Access_Type
or else Ekind (BT1) = E_Access_Type)
......
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