Commit 6d0b56ad by Arnaud Charlet

[multiple changes]

2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_CPP_Init_Procedure): Remove
	Flag_Decl. Do not analyze the declaration of the flag as it is
	not part of the tree yet, instead add it to the freeze actions
	of the C++ type.

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Apply_Scalar_Range_Check): Make sure we handle
	case of OUT and IN OUT parameter correctly (where Source_Typ is
	set), we were missing one case where a check must be applied.

2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch8.adb (Build_Class_Wide_Wrapper): Update the comment on
	the generated code. Instead of hiding the renaming and using the
	wrapper as the proper association, have the subprogram renaming
	alias the wrapper.
	(Build_Spec): The entity of the wrapper is
	now derived from the entity of the related primitive.

2014-08-04  Emmanuel Briot  <briot@adacore.com>

	* s-regpat.adb: s-regpat.adb (Parse): fix incorrect link when
	using non-capturing groups.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* inline.adb (Build_Body_To_Inline): Remove Unmodified and
	related pragmas before copying the original body, to prevent
	spurious errors when the pragmas apply to formals that will not
	appear in the inlined body.

From-SVN: r213554
parent ff7a5bcb
2014-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb (Build_CPP_Init_Procedure): Remove
Flag_Decl. Do not analyze the declaration of the flag as it is
not part of the tree yet, instead add it to the freeze actions
of the C++ type.
2014-08-04 Robert Dewar <dewar@adacore.com>
* checks.adb (Apply_Scalar_Range_Check): Make sure we handle
case of OUT and IN OUT parameter correctly (where Source_Typ is
set), we were missing one case where a check must be applied.
2014-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch8.adb (Build_Class_Wide_Wrapper): Update the comment on
the generated code. Instead of hiding the renaming and using the
wrapper as the proper association, have the subprogram renaming
alias the wrapper.
(Build_Spec): The entity of the wrapper is
now derived from the entity of the related primitive.
2014-08-04 Emmanuel Briot <briot@adacore.com>
* s-regpat.adb: s-regpat.adb (Parse): fix incorrect link when
using non-capturing groups.
2014-08-04 Ed Schonberg <schonberg@adacore.com>
* inline.adb (Build_Body_To_Inline): Remove Unmodified and
related pragmas before copying the original body, to prevent
spurious errors when the pragmas apply to formals that will not
appear in the inlined body.
2014-08-04 Robert Dewar <dewar@adacore.com> 2014-08-04 Robert Dewar <dewar@adacore.com>
* exp_prag.adb, sem_ch7.adb, einfo.adb, sem_prag.adb, sem_util.adb, * exp_prag.adb, sem_ch7.adb, einfo.adb, sem_prag.adb, sem_util.adb,
......
...@@ -2971,11 +2971,18 @@ package body Checks is ...@@ -2971,11 +2971,18 @@ package body Checks is
and then Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ) and then Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ)
and then and then
(In_Subrange_Of (S_Typ, Target_Typ, Fixed_Int) (In_Subrange_Of (S_Typ, Target_Typ, Fixed_Int)
-- Also check if the expression itself is in the range of the
-- target type if it is a known at compile time value. We skip
-- this test if S_Typ is set since for OUT and IN OUT parameters
-- the Expr itself is not relevant to the checking.
or else or else
Is_In_Range (Expr, Target_Typ, (No (Source_Typ)
Assume_Valid => True, and then Is_In_Range (Expr, Target_Typ,
Fixed_Int => Fixed_Int, Assume_Valid => True,
Int_Real => Int_Real)) Fixed_Int => Fixed_Int,
Int_Real => Int_Real)))
then then
return; return;
......
...@@ -2203,7 +2203,6 @@ package body Exp_Ch3 is ...@@ -2203,7 +2203,6 @@ package body Exp_Ch3 is
Body_Node : Node_Id; Body_Node : Node_Id;
Body_Stmts : List_Id; Body_Stmts : List_Id;
Flag_Id : Entity_Id; Flag_Id : Entity_Id;
Flag_Decl : Node_Id;
Handled_Stmt_Node : Node_Id; Handled_Stmt_Node : Node_Id;
Init_Tags_List : List_Id; Init_Tags_List : List_Id;
Proc_Id : Entity_Id; Proc_Id : Entity_Id;
...@@ -2235,19 +2234,16 @@ package body Exp_Ch3 is ...@@ -2235,19 +2234,16 @@ package body Exp_Ch3 is
Flag_Id := Make_Temporary (Loc, 'F'); Flag_Id := Make_Temporary (Loc, 'F');
Flag_Decl := Append_Freeze_Action (Rec_Type,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Flag_Id, Defining_Identifier => Flag_Id,
Object_Definition => Object_Definition =>
New_Occurrence_Of (Standard_Boolean, Loc), New_Occurrence_Of (Standard_Boolean, Loc),
Expression => Expression =>
New_Occurrence_Of (Standard_True, Loc)); New_Occurrence_Of (Standard_True, Loc)));
Analyze (Flag_Decl);
Append_Freeze_Action (Rec_Type, Flag_Decl);
Body_Stmts := New_List; Body_Stmts := New_List;
Body_Node := New_Node (N_Subprogram_Body, Loc); Body_Node := New_Node (N_Subprogram_Body, Loc);
Proc_Spec_Node := New_Node (N_Procedure_Specification, Loc); Proc_Spec_Node := New_Node (N_Procedure_Specification, Loc);
...@@ -2262,7 +2258,7 @@ package body Exp_Ch3 is ...@@ -2262,7 +2258,7 @@ package body Exp_Ch3 is
Set_Parameter_Specifications (Proc_Spec_Node, New_List); Set_Parameter_Specifications (Proc_Spec_Node, New_List);
Set_Specification (Body_Node, Proc_Spec_Node); Set_Specification (Body_Node, Proc_Spec_Node);
Set_Declarations (Body_Node, New_List); Set_Declarations (Body_Node, New_List);
Init_Tags_List := Build_Inherit_CPP_Prims (Rec_Type); Init_Tags_List := Build_Inherit_CPP_Prims (Rec_Type);
......
...@@ -1168,6 +1168,10 @@ package body Inline is ...@@ -1168,6 +1168,10 @@ package body Inline is
Make_Defining_Identifier (Sloc (N), Name_uParent)); Make_Defining_Identifier (Sloc (N), Name_uParent));
Set_Corresponding_Spec (Original_Body, Empty); Set_Corresponding_Spec (Original_Body, Empty);
-- Remove those pragmas that have no meaining in an inlined body.
Remove_Pragmas (Original_Body);
Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False); Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False);
-- Set return type of function, which is also global and does not need -- Set return type of function, which is also global and does not need
...@@ -1190,7 +1194,6 @@ package body Inline is ...@@ -1190,7 +1194,6 @@ package body Inline is
Expander_Mode_Save_And_Set (False); Expander_Mode_Save_And_Set (False);
Full_Analysis := False; Full_Analysis := False;
Remove_Pragmas (Body_To_Analyze);
Analyze (Body_To_Analyze); Analyze (Body_To_Analyze);
Push_Scope (Defining_Entity (Body_To_Analyze)); Push_Scope (Defining_Entity (Body_To_Analyze));
......
...@@ -923,8 +923,7 @@ package body System.Regpat is ...@@ -923,8 +923,7 @@ package body System.Regpat is
else else
-- Need to keep looking after the closing parenthesis -- Need to keep looking after the closing parenthesis
Ender := Emit_Ptr;
null;
end if; end if;
else else
......
...@@ -1845,12 +1845,12 @@ package body Sem_Ch8 is ...@@ -1845,12 +1845,12 @@ package body Sem_Ch8 is
-- --
-- The above is replaced the following wrapper/renaming combination: -- The above is replaced the following wrapper/renaming combination:
-- --
-- procedure Prim_Op (Param : Formal_Typ) is -- wrapper -- procedure Wrapper (Param : Formal_Typ) is -- wrapper
-- begin -- begin
-- Prim_Op (Param); -- primitive -- Prim_Op (Param); -- primitive
-- end Wrapper; -- end Wrapper;
-- --
-- procedure Dummy (Param : Formal_Typ) renames Prim_Op; -- procedure Prim_Op (Param : Formal_Typ) renames Wrapper;
-- --
-- This transformation applies only if there is no explicit visible -- This transformation applies only if there is no explicit visible
-- class-wide operation at the point of the instantiation. Ren_Id is -- class-wide operation at the point of the instantiation. Ren_Id is
...@@ -1977,7 +1977,8 @@ package body Sem_Ch8 is ...@@ -1977,7 +1977,8 @@ package body Sem_Ch8 is
function Build_Spec (Subp_Id : Entity_Id) return Node_Id is function Build_Spec (Subp_Id : Entity_Id) return Node_Id is
Params : constant List_Id := Copy_Parameter_List (Subp_Id); Params : constant List_Id := Copy_Parameter_List (Subp_Id);
Spec_Id : constant Entity_Id := Spec_Id : constant Entity_Id :=
Make_Defining_Identifier (Loc, Chars (Subp_Id)); Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Subp_Id), 'R'));
begin begin
if Ekind (Formal_Spec) = E_Procedure then if Ekind (Formal_Spec) = E_Procedure then
...@@ -2290,12 +2291,10 @@ package body Sem_Ch8 is ...@@ -2290,12 +2291,10 @@ package body Sem_Ch8 is
return; return;
end if; end if;
-- Set the proper entity of the renamed generic formal subprogram, -- At this point resolution has taken place and the name is no longer
-- reset its overloaded status and mark the primitive as referenced -- overloaded. Mark the primitive as referenced.
-- now that resolution has finally taken place.
Set_Entity (Nam, Prim_Op); Set_Is_Overloaded (Name (N), False);
Set_Is_Overloaded (Nam, False);
Set_Referenced (Prim_Op); Set_Referenced (Prim_Op);
-- Step 3: Create the declaration and the body of the wrapper, insert -- Step 3: Create the declaration and the body of the wrapper, insert
...@@ -2304,6 +2303,15 @@ package body Sem_Ch8 is ...@@ -2304,6 +2303,15 @@ package body Sem_Ch8 is
Spec_Decl := Spec_Decl :=
Make_Subprogram_Declaration (Loc, Make_Subprogram_Declaration (Loc,
Specification => Build_Spec (Ren_Id)); Specification => Build_Spec (Ren_Id));
Insert_Before_And_Analyze (N, Spec_Decl);
-- If the operator carries an Eliminated pragma, indicate that the
-- wrapper is also to be eliminated, to prevent spurious error when
-- using gnatelim on programs that include box-initialization of
-- equality operators.
Wrap_Id := Defining_Entity (Spec_Decl);
Set_Is_Eliminated (Wrap_Id, Is_Eliminated (Prim_Op));
Body_Decl := Body_Decl :=
Make_Subprogram_Body (Loc, Make_Subprogram_Body (Loc,
...@@ -2318,16 +2326,6 @@ package body Sem_Ch8 is ...@@ -2318,16 +2326,6 @@ package body Sem_Ch8 is
Parameter_Specifications Parameter_Specifications
(Specification (Spec_Decl)))))); (Specification (Spec_Decl))))));
Insert_Before_And_Analyze (N, Spec_Decl);
Wrap_Id := Defining_Entity (Spec_Decl);
-- If the operator carries an Eliminated pragma, indicate that the
-- wrapper is also to be eliminated, to prevent spurious error when
-- using gnatelim on programs that include box-initialization of
-- equality operators.
Set_Is_Eliminated (Wrap_Id, Is_Eliminated (Prim_Op));
-- The generated body does not freeze and must be analyzed when the -- The generated body does not freeze and must be analyzed when the
-- class-wide wrapper is frozen. The body is only needed if expansion -- class-wide wrapper is frozen. The body is only needed if expansion
-- is enabled. -- is enabled.
...@@ -2336,12 +2334,9 @@ package body Sem_Ch8 is ...@@ -2336,12 +2334,9 @@ package body Sem_Ch8 is
Append_Freeze_Action (Wrap_Id, Body_Decl); Append_Freeze_Action (Wrap_Id, Body_Decl);
end if; end if;
-- Step 4: Once the proper actual type and primitive operation are -- Step 4: The subprogram renaming aliases the wrapper
-- known, hide the renaming declaration from visibility by giving it
-- a dummy name.
Set_Defining_Unit_Name (Spec, Make_Temporary (Loc, 'R')); Rewrite (Nam, New_Occurrence_Of (Wrap_Id, Loc));
Ren_Id := Analyze_Subprogram_Specification (Spec);
end Build_Class_Wide_Wrapper; end Build_Class_Wide_Wrapper;
-------------------------- --------------------------
......
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