From patchwork Mon Oct 29 10:08:24 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [Ada] Source location of generated nodes for To_Any calls From: Arnaud Charlet X-Patchwork-Id: 194934 Message-Id: <20121029100824.GA21030@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Date: Mon, 29 Oct 2012 06:08:24 -0400 This change modifies the source location assigned to expander generated nodes produced in the context of the distributed systems annex. Previously, we always assigned code generated for the conversion of an expression to the intermediate Any representation the location of the expression. However when such a call is generated as part of the generation of calling stubs for an RACW, this may lead to spurious ABE warnings if the RACW is declared earlier than the point where the expression occurs (case e.g. of a default value of a discriminant for a discriminated type used as formal parameter type in an RACW primitive operation, when the discriminated type declaration occurs after the RACW declaration). Tested on x86_64-pc-linux-gnu, committed on trunk 2012-10-29 Thomas Quinot * exp_attr.adb, exp_dist.adb, exp_dist.ads (Build_To_Any_Call): Pass an explicit Loc parameter to set the source location of generated nodes. Index: exp_attr.adb =================================================================== --- exp_attr.adb (revision 192908) +++ exp_attr.adb (working copy) @@ -5141,7 +5141,8 @@ begin Rewrite (N, Build_To_Any_Call - (Convert_To (P_Type, + (Loc, + Convert_To (P_Type, Relocate_Node (First (Exprs))), Decls)); Insert_Actions (N, Decls); Analyze_And_Resolve (N, RTE (RE_Any)); Index: exp_dist.adb =================================================================== --- exp_dist.adb (revision 192908) +++ exp_dist.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -803,12 +803,14 @@ -- the declaration and entity for the newly-created function. function Build_To_Any_Call - (N : Node_Id; + (Loc : Source_Ptr; + N : Node_Id; Decls : List_Id) return Node_Id; -- Build call to To_Any attribute function with expression as actual - -- parameter. Decls is the declarations list for an appropriate - -- enclosing scope of the point where the call will be inserted; if - -- the To_Any attribute for Typ needs to be generated at this point, + -- parameter. Loc is the reference location ofr generated nodes, + -- Decls is the declarations list for an appropriate enclosing scope + -- of the point where the call will be inserted; if the To_Any + -- attribute for the type of N needs to be generated at this point, -- its declaration is appended to Decls. procedure Build_To_Any_Function @@ -879,7 +881,8 @@ renames PolyORB_Support.Helpers.Build_From_Any_Call; function Build_To_Any_Call - (N : Node_Id; + (Loc : Source_Ptr; + N : Node_Id; Decls : List_Id) return Node_Id renames PolyORB_Support.Helpers.Build_To_Any_Call; @@ -6562,7 +6565,7 @@ Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc), Expression => PolyORB_Support.Helpers.Build_To_Any_Call - (RACW_Parameter, No_List))); + (Loc, RACW_Parameter, No_List))); Statements := New_List ( Make_Procedure_Call_Statement (Loc, @@ -7362,7 +7365,7 @@ -- the first one. Expr := PolyORB_Support.Helpers.Build_To_Any_Call - (Actual_Parameter, Decls); + (Loc, Actual_Parameter, Decls); else Expr := Make_Function_Call (Loc, @@ -7448,7 +7451,7 @@ New_Occurrence_Of (RTE (RE_Any), Loc), Expression => PolyORB_Support.Helpers.Build_To_Any_Call - (Parameter_Exp, Decls))); + (Loc, Parameter_Exp, Decls))); Append_To (Extra_Formal_Statements, Add_Parameter_To_NVList (Loc, @@ -7934,7 +7937,7 @@ Parameter_Associations => New_List ( New_Occurrence_Of (Any, Loc), PolyORB_Support.Helpers.Build_To_Any_Call - (New_Occurrence_Of (Object, Loc), Decls)))); + (Loc, New_Occurrence_Of (Object, Loc), Decls)))); end if; -- For RACW controlling formals, the Etyp of Object is always @@ -8094,7 +8097,7 @@ Parameter_Associations => New_List ( New_Occurrence_Of (Request_Parameter, Loc), PolyORB_Support.Helpers.Build_To_Any_Call - (New_Occurrence_Of (Result, Loc), Decls)))); + (Loc, New_Occurrence_Of (Result, Loc), Decls)))); -- A DSA function does not have out or inout arguments end; @@ -9219,11 +9222,10 @@ ----------------------- function Build_To_Any_Call - (N : Node_Id; + (Loc : Source_Ptr; + N : Node_Id; Decls : List_Id) return Node_Id is - Loc : constant Source_Ptr := Sloc (N); - Typ : Entity_Id := Etype (N); U_Type : Entity_Id; C_Type : Entity_Id; @@ -9463,7 +9465,8 @@ (Rt_Type, New_Occurrence_Of (Expr_Parameter, Loc)); begin - Set_Expression (Any_Decl, Build_To_Any_Call (Expr, Decls)); + Set_Expression (Any_Decl, + Build_To_Any_Call (Loc, Expr, Decls)); end; elsif Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) then @@ -9479,7 +9482,7 @@ begin Set_Expression - (Any_Decl, Build_To_Any_Call (Expr, Decls)); + (Any_Decl, Build_To_Any_Call (Loc, Expr, Decls)); end; -- Comment needed here (and label on declare block ???) @@ -9535,7 +9538,7 @@ RTE (RE_Add_Aggregate_Element), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Container, Loc), - Build_To_Any_Call (Field_Ref, Decls)))); + Build_To_Any_Call (Loc, Field_Ref, Decls)))); else -- A variant part @@ -9660,7 +9663,8 @@ Parameter_Associations => New_List ( New_Occurrence_Of (Union_Any, Loc), Build_To_Any_Call - (Make_Discriminant_Reference, + (Loc, + Make_Discriminant_Reference, Block_Decls)))); -- Populate inner struct aggregate @@ -9761,7 +9765,8 @@ Choices => New_List ( Make_Integer_Literal (Loc, Counter)), Expression => - Build_To_Any_Call (Discriminant, Decls))); + Build_To_Any_Call (Loc, + Discriminant, Decls))); end; Counter := Counter + 1; @@ -9850,7 +9855,7 @@ if Etype (Datum) = RTE (RE_Any) then Element_Any := Datum; else - Element_Any := Build_To_Any_Call (Datum, Decls); + Element_Any := Build_To_Any_Call (Loc, Datum, Decls); end if; Append_To (Stmts, @@ -9889,7 +9894,7 @@ RTE (RE_Add_Aggregate_Element), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Any, Loc), - Build_To_Any_Call ( + Build_To_Any_Call (Loc, OK_Convert_To (Etype (Index), Make_Attribute_Reference (Loc, Prefix => @@ -9910,7 +9915,7 @@ -- Integer types Set_Expression (Any_Decl, - Build_To_Any_Call ( + Build_To_Any_Call (Loc, OK_Convert_To ( Find_Numeric_Representation (Typ), New_Occurrence_Of (Expr_Parameter, Loc)), @@ -10454,7 +10459,7 @@ Set_Etype (Expr, Disc_Type); Append_To (Union_TC_Params, - Build_To_Any_Call (Expr, Decls)); + Build_To_Any_Call (Loc, Expr, Decls)); Add_Params_For_Variant_Components; J := J + Uint_1; @@ -10495,7 +10500,7 @@ begin Set_Etype (Exp, Disc_Type); Append_To (Union_TC_Params, - Build_To_Any_Call (Exp, Decls)); + Build_To_Any_Call (Loc, Exp, Decls)); end; Add_Params_For_Variant_Components; @@ -10509,7 +10514,7 @@ New_Copy_Tree (Choice); begin Append_To (Union_TC_Params, - Build_To_Any_Call (Exp, Decls)); + Build_To_Any_Call (Loc, Exp, Decls)); end; Add_Params_For_Variant_Components; @@ -10679,7 +10684,7 @@ if Constrained then Inner_TypeCode := Make_Constructed_TypeCode (RTE (RE_TC_Array), New_List ( - Build_To_Any_Call ( + Build_To_Any_Call (Loc, OK_Convert_To (RTE (RE_Unsigned_32), Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Typ, Loc), @@ -10688,7 +10693,7 @@ Make_Integer_Literal (Loc, Intval => Ndim - J + 1)))), Decls), - Build_To_Any_Call (Inner_TypeCode, Decls))); + Build_To_Any_Call (Loc, Inner_TypeCode, Decls))); else -- Unconstrained case: add low bound for each @@ -10705,11 +10710,11 @@ Inner_TypeCode := Make_Constructed_TypeCode (RTE (RE_TC_Sequence), New_List ( - Build_To_Any_Call ( + Build_To_Any_Call (Loc, OK_Convert_To (RTE (RE_Unsigned_32), Make_Integer_Literal (Loc, 0)), Decls), - Build_To_Any_Call (Inner_TypeCode, Decls))); + Build_To_Any_Call (Loc, Inner_TypeCode, Decls))); end if; end loop; Index: exp_dist.ads =================================================================== --- exp_dist.ads (revision 192908) +++ exp_dist.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -144,13 +144,14 @@ -- declaration is appended to Decls. function Build_To_Any_Call - (N : Node_Id; + (Loc : Source_Ptr; + N : Node_Id; Decls : List_Id) return Node_Id; -- Build call to To_Any attribute function with expression as actual - -- parameter. Decls is the declarations list for an appropriate - -- enclosing scope of the point where the call will be inserted; if - -- the To_Any attribute for Typ needs to be generated at this point, - -- its declaration is appended to Decls. + -- parameter. Loc is the reference location for generated nodes, Decls is + -- the declarations list for an appropriate enclosing scope of the point + -- where the call will be inserted; if the To_Any attribute for Typ needs + -- to be generated at this point, its declaration is appended to Decls. function Build_TypeCode_Call (Loc : Source_Ptr;