Patchwork [Ada] Source location of generated nodes for To_Any calls

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 29, 2012, 10:08 a.m.
Message ID <20121029100824.GA21030@adacore.com>
Download mbox | patch
Permalink /patch/194934/
State New
Headers show

Comments

Arnaud Charlet - Oct. 29, 2012, 10:08 a.m.
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  <quinot@adacore.com>

	* 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.

Patch

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;