From 6d0b56ad0cbcc35f2e7b9cd24529a45ed1bbb865 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 12:03:31 +0200 Subject: [PATCH] [multiple changes] 2014-08-04 Hristian Kirtchev * 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 * 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 * 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 * s-regpat.adb: s-regpat.adb (Parse): fix incorrect link when using non-capturing groups. 2014-08-04 Ed Schonberg * 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 --- gcc/ada/ChangeLog | 34 ++++++++++++++++++++++++++++++++++ gcc/ada/checks.adb | 15 +++++++++++---- gcc/ada/exp_ch3.adb | 12 ++++-------- gcc/ada/inline.adb | 5 ++++- gcc/ada/s-regpat.adb | 3 +-- gcc/ada/sem_ch8.adb | 41 ++++++++++++++++++----------------------- 6 files changed, 72 insertions(+), 38 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 94286c50b07..960102e22e8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2014-08-04 Hristian Kirtchev + + * 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 + + * 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 + + * 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 + + * s-regpat.adb: s-regpat.adb (Parse): fix incorrect link when + using non-capturing groups. + +2014-08-04 Ed Schonberg + + * 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 * exp_prag.adb, sem_ch7.adb, einfo.adb, sem_prag.adb, sem_util.adb, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 8072629666d..05f4b7e476a 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2971,11 +2971,18 @@ package body Checks is and then Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ) and then (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 - Is_In_Range (Expr, Target_Typ, - Assume_Valid => True, - Fixed_Int => Fixed_Int, - Int_Real => Int_Real)) + (No (Source_Typ) + and then Is_In_Range (Expr, Target_Typ, + Assume_Valid => True, + Fixed_Int => Fixed_Int, + Int_Real => Int_Real))) then return; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 503b374dcb4..6eec78a4732 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2203,7 +2203,6 @@ package body Exp_Ch3 is Body_Node : Node_Id; Body_Stmts : List_Id; Flag_Id : Entity_Id; - Flag_Decl : Node_Id; Handled_Stmt_Node : Node_Id; Init_Tags_List : List_Id; Proc_Id : Entity_Id; @@ -2235,19 +2234,16 @@ package body Exp_Ch3 is Flag_Id := Make_Temporary (Loc, 'F'); - Flag_Decl := + Append_Freeze_Action (Rec_Type, Make_Object_Declaration (Loc, Defining_Identifier => Flag_Id, Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc), Expression => - New_Occurrence_Of (Standard_True, Loc)); - - Analyze (Flag_Decl); - Append_Freeze_Action (Rec_Type, Flag_Decl); + New_Occurrence_Of (Standard_True, Loc))); 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); @@ -2262,7 +2258,7 @@ package body Exp_Ch3 is Set_Parameter_Specifications (Proc_Spec_Node, New_List); 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); diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index c2865ea93e5..380fa25939f 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -1168,6 +1168,10 @@ package body Inline is Make_Defining_Identifier (Sloc (N), Name_uParent)); 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); -- Set return type of function, which is also global and does not need @@ -1190,7 +1194,6 @@ package body Inline is Expander_Mode_Save_And_Set (False); Full_Analysis := False; - Remove_Pragmas (Body_To_Analyze); Analyze (Body_To_Analyze); Push_Scope (Defining_Entity (Body_To_Analyze)); diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index add78bdb4c6..d5ef0229e47 100644 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -923,8 +923,7 @@ package body System.Regpat is else -- Need to keep looking after the closing parenthesis - - null; + Ender := Emit_Ptr; end if; else diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 0521efb9033..655f38bf6f4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1845,12 +1845,12 @@ package body Sem_Ch8 is -- -- 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 -- Prim_Op (Param); -- primitive -- 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 -- class-wide operation at the point of the instantiation. Ren_Id is @@ -1977,7 +1977,8 @@ package body Sem_Ch8 is function Build_Spec (Subp_Id : Entity_Id) return Node_Id is Params : constant List_Id := Copy_Parameter_List (Subp_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 if Ekind (Formal_Spec) = E_Procedure then @@ -2290,12 +2291,10 @@ package body Sem_Ch8 is return; end if; - -- Set the proper entity of the renamed generic formal subprogram, - -- reset its overloaded status and mark the primitive as referenced - -- now that resolution has finally taken place. + -- At this point resolution has taken place and the name is no longer + -- overloaded. Mark the primitive as referenced. - Set_Entity (Nam, Prim_Op); - Set_Is_Overloaded (Nam, False); + Set_Is_Overloaded (Name (N), False); Set_Referenced (Prim_Op); -- Step 3: Create the declaration and the body of the wrapper, insert @@ -2304,6 +2303,15 @@ package body Sem_Ch8 is Spec_Decl := Make_Subprogram_Declaration (Loc, 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 := Make_Subprogram_Body (Loc, @@ -2318,16 +2326,6 @@ package body Sem_Ch8 is Parameter_Specifications (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 -- class-wide wrapper is frozen. The body is only needed if expansion -- is enabled. @@ -2336,12 +2334,9 @@ package body Sem_Ch8 is Append_Freeze_Action (Wrap_Id, Body_Decl); end if; - -- Step 4: Once the proper actual type and primitive operation are - -- known, hide the renaming declaration from visibility by giving it - -- a dummy name. + -- Step 4: The subprogram renaming aliases the wrapper - Set_Defining_Unit_Name (Spec, Make_Temporary (Loc, 'R')); - Ren_Id := Analyze_Subprogram_Specification (Spec); + Rewrite (Nam, New_Occurrence_Of (Wrap_Id, Loc)); end Build_Class_Wide_Wrapper; -------------------------- -- 2.30.2