[multiple changes]
authorPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 5 Dec 2017 11:58:13 +0000 (11:58 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 5 Dec 2017 11:58:13 +0000 (11:58 +0000)
2017-12-05  Eric Botcazou  <ebotcazou@adacore.com>

* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Use the SLOC of the
iteration scheme throughout, except for the new loop statement(s).

2017-12-05  Ed Schonberg  <schonberg@adacore.com>

* exp_aggr.adb (Gen_Assign): Do not analyze the expressionn of the
assignment if it is part of an Iterated_Component_Association: the
analysis needs to take place once the loop structure is analyzed and
the loop parameter made visible, because references to it typically
appear in the corresponding expression.  This is necessary if the
expression is an aggregate, because previous pre-analysis of the
expression does not handle nested aggregates properly.

2017-12-05  Bob Duff  <duff@adacore.com>

* sem_res.adb (Resolve_Allocator): Avoid coextension processing for an
allocator that is the expansion of a build-in-place function call.

2017-12-05  Olivier Hainque  <hainque@adacore.com>

libgnat/
* s-trasym__dwarf.adb (spec of Module_Name.Get): Instead of
possibly adjusting the lookup address by a load address, expect
a extra argument through which the load address can be conveyed
separately.
(Multi_Module_Symbolic_Traceback): Adjust accordingly. Pass the
retrieved load address to Init_Module.
* s-tsmona__linux.adb (Get): Honor the new interface.
* s-tsmona__mingw.adb (Get): Likewise.
* s-dwalin.ads: Adjust comments to be explicit about which
addresses are from module info and which are run-time addresses,
offsetted by the module load address.
* s-dwalin.adb (Set_Load_Address): Simply set C.Load_Slide.
Do not alter the module Low and High (relative) addresses.
(Is_Inside): Improve documentation regarding the kinds of addresses
at hand and correct the test.
(Symbolic_Traceback): Use separate variables with explicit names
for the address in traceback (run-time value) and the address to
lookup within the shared object (module-relative). Adjust the
computation of address passed to Symbolic_Address for symbolization.

From-SVN: r255411

gcc/ada/ChangeLog
gcc/ada/exp_aggr.adb
gcc/ada/exp_ch5.adb
gcc/ada/libgnat/s-dwalin.adb
gcc/ada/libgnat/s-dwalin.ads
gcc/ada/libgnat/s-trasym__dwarf.adb
gcc/ada/libgnat/s-tsmona__linux.adb
gcc/ada/libgnat/s-tsmona__mingw.adb
gcc/ada/sem_res.adb

index 2da67a1af24726ed2ab6c4d9bc6d15dc2dd7051c..36170ec4081dbc3b6a174aa5486bef4e8cce20f9 100644 (file)
@@ -1,3 +1,46 @@
+2017-12-05  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Use the SLOC of the
+       iteration scheme throughout, except for the new loop statement(s).
+
+2017-12-05  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_aggr.adb (Gen_Assign): Do not analyze the expressionn of the
+       assignment if it is part of an Iterated_Component_Association: the
+       analysis needs to take place once the loop structure is analyzed and
+       the loop parameter made visible, because references to it typically
+       appear in the corresponding expression.  This is necessary if the
+       expression is an aggregate, because previous pre-analysis of the
+       expression does not handle nested aggregates properly.
+
+2017-12-05  Bob Duff  <duff@adacore.com>
+
+       * sem_res.adb (Resolve_Allocator): Avoid coextension processing for an
+       allocator that is the expansion of a build-in-place function call.
+
+2017-12-05  Olivier Hainque  <hainque@adacore.com>
+
+libgnat/
+       * s-trasym__dwarf.adb (spec of Module_Name.Get): Instead of
+       possibly adjusting the lookup address by a load address, expect
+       a extra argument through which the load address can be conveyed
+       separately.
+       (Multi_Module_Symbolic_Traceback): Adjust accordingly. Pass the
+       retrieved load address to Init_Module.
+       * s-tsmona__linux.adb (Get): Honor the new interface.
+       * s-tsmona__mingw.adb (Get): Likewise.
+       * s-dwalin.ads: Adjust comments to be explicit about which
+       addresses are from module info and which are run-time addresses,
+       offsetted by the module load address.
+       * s-dwalin.adb (Set_Load_Address): Simply set C.Load_Slide.
+       Do not alter the module Low and High (relative) addresses.
+       (Is_Inside): Improve documentation regarding the kinds of addresses
+       at hand and correct the test.
+       (Symbolic_Traceback): Use separate variables with explicit names
+       for the address in traceback (run-time value) and the address to
+       lookup within the shared object (module-relative). Adjust the
+       computation of address passed to Symbolic_Address for symbolization.
+
 2017-12-05  Arnaud Charlet  <charlet@adacore.com>
 
        * opt.ads (Expand_Nonbinary_Modular_Ops): New flag.
index 919f46fde00673116c5e3f57b98ae3ad9543c0a9..581e31cfb929a486f57410116d55183673d2d1a8 100644 (file)
@@ -1533,7 +1533,14 @@ package body Exp_Aggr is
             --  the analysis of non-array aggregates now in order to get the
             --  value of Expansion_Delayed flag for the inner aggregate ???
 
-            if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ) then
+            --  In the case of an iterated component association, the analysis
+            --  of the generated loop will analyze the expression in the
+            --  proper context, in which the loop parameter is visible.
+
+            if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ)
+              and then
+                Nkind (Parent (Expr_Q)) /= N_Iterated_Component_Association
+            then
                Analyze_And_Resolve (Expr_Q, Comp_Typ);
             end if;
 
@@ -5366,6 +5373,10 @@ package body Exp_Aggr is
             Expr : Node_Id;
 
          begin
+            if Nkind (Parent (Aggr)) = N_Iterated_Component_Association then
+               return False;
+            end if;
+
             if Present (Expressions (Aggr)) then
                Expr := First (Expressions (Aggr));
                while Present (Expr) loop
index 4b2b5dc69d001c806aa28cba89d0eaa5f942228b..5779d2362cf6517cd2d2eb6c5039c0d6dbce5165 100644 (file)
@@ -3673,7 +3673,7 @@ package body Exp_Ch5 is
       Array_Typ  : constant Entity_Id  := Base_Type (Etype (Array_Node));
       Array_Dim  : constant Pos        := Number_Dimensions (Array_Typ);
       Id         : constant Entity_Id  := Defining_Identifier (I_Spec);
-      Loc        : constant Source_Ptr := Sloc (N);
+      Loc        : constant Source_Ptr := Sloc (Isc);
       Stats      : constant List_Id    := Statements (N);
       Core_Loop  : Node_Id;
       Dim1       : Int;
@@ -3734,7 +3734,7 @@ package body Exp_Ch5 is
       end if;
 
       Core_Loop :=
-        Make_Loop_Statement (Loc,
+        Make_Loop_Statement (Sloc (N),
           Iteration_Scheme =>
             Make_Iteration_Scheme (Loc,
               Loop_Parameter_Specification =>
@@ -3771,7 +3771,7 @@ package body Exp_Ch5 is
             --    end loop;
 
             Core_Loop :=
-              Make_Loop_Statement (Loc,
+              Make_Loop_Statement (Sloc (N),
                 Iteration_Scheme =>
                   Make_Iteration_Scheme (Loc,
                     Loop_Parameter_Specification =>
index 1791b2dfcf0de66d5be9bd168cff07d49b3251b6..af11740235c11feddcfa21174a4f5ac11b784473 100644 (file)
@@ -372,7 +372,8 @@ package body System.Dwarf_Lines is
 
    function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean is
    begin
-      return Addr >= C.Low and Addr <= C.High;
+      return (Addr >= To_Address (To_Integer (C.Low) + C.Load_Slide)
+                and Addr <= To_Address (To_Integer (C.High) + C.Load_Slide));
    end Is_Inside;
 
    ---------
@@ -771,15 +772,7 @@ package body System.Dwarf_Lines is
 
    procedure Set_Load_Address (C : in out Dwarf_Context; Addr : Address) is
    begin
-      if Addr = Null_Address then
-         return;
-      else
-         C.Load_Slide :=
-           To_Integer (Addr) - Integer_Address (Get_Load_Address (C.Obj.all));
-
-         C.Low  := To_Address (To_Integer (C.Low) + C.Load_Slide);
-         C.High := To_Address (To_Integer (C.High) + C.Load_Slide);
-      end if;
+      C.Load_Slide := To_Integer (Addr);
    end Set_Load_Address;
 
    ------------------
@@ -1523,8 +1516,10 @@ package body System.Dwarf_Lines is
       Res          : in out System.Bounded_Strings.Bounded_String)
    is
       use Ada.Characters.Handling;
-      C    : Dwarf_Context := Cin;
-      Addr : Address;
+      C : Dwarf_Context := Cin;
+
+      Addr_In_Traceback : Address;
+      Addr_To_Lookup    : Address;
 
       Dir_Name    : Str_Access;
       File_Name   : Str_Access;
@@ -1543,10 +1538,14 @@ package body System.Dwarf_Lines is
          --  If the buffer is full, no need to do any useless work
          exit when Is_Full (Res);
 
-         Addr := PC_For (Traceback (J));
+         Addr_In_Traceback := PC_For (Traceback (J));
+
+         Addr_To_Lookup := To_Address
+           (To_Integer (Addr_In_Traceback) - C.Load_Slide);
+
          Symbolic_Address
            (C,
-            To_Address (To_Integer (Addr) + C.Load_Slide),
+            Addr_To_Lookup,
             Dir_Name,
             File_Name,
             Subprg_Name,
@@ -1608,7 +1607,7 @@ package body System.Dwarf_Lines is
             if Suppress_Hex then
                Append (Res, "...");
             else
-               Append_Address (Res, Addr);
+               Append_Address (Res, Addr_In_Traceback);
             end if;
 
             if Subprg_Name.Len > 0 then
index 3608fef3ade827c8b70a152349da294258b2240b..982b30fda3277647302d2e65b24f633eefa0ae69 100644 (file)
@@ -73,11 +73,11 @@ package System.Dwarf_Lines is
 
    function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean;
    pragma Inline (Is_Inside);
-   --  Return true iff Addr is within the module
+   --  Return true iff a run-time address Addr is within the module
 
    function Low (C : Dwarf_Context) return Address;
    pragma Inline (Low);
-   --  Return the lowest address of C
+   --  Return the lowest address of C, from the module object file
 
    procedure Dump (C : in out Dwarf_Context);
    --  Dump each row found in the object's .debug_lines section to standard out
@@ -165,7 +165,7 @@ private
    type Dwarf_Context (In_Exception : Boolean := False) is record
       Load_Slide : System.Storage_Elements.Integer_Address := 0;
       Low, High  : Address;
-      --  Bounds of the module
+      --  Bounds of the module, per the module object file
 
       Obj : SOR.Object_File_Access;
       --  The object file containing dwarf sections
index 9655722b923bdf5ba7817862edcca2f1a96b2430..b1fb480c691013226aa675c6d663ce742229b7c1 100644 (file)
@@ -132,10 +132,12 @@ package body System.Traceback.Symbolic is
       procedure Build_Cache_For_All_Modules;
       --  Create the cache for all current modules
 
-      function Get (Addr : access System.Address) return String;
-      --  Returns the module name for the given address, Addr may be updated
-      --  to be set relative to a shared library. This depends on the platform.
-      --  Returns an empty string for the main executable.
+      function Get (Addr : System.Address;
+                    Load_Addr : access System.Address) return String;
+      --  Returns the module name for the given address Addr, or an empty
+      --  string for the main executable.  Load_Addr is set to the shared
+      --  library load address if this information is available, or to
+      --  System.Null_Address otherwise.
 
       function Is_Supported return Boolean;
       pragma Inline (Is_Supported);
@@ -499,12 +501,14 @@ package body System.Traceback.Symbolic is
 
          --  Otherwise, try a shared library
          declare
-            Addr    : aliased System.Address := Traceback (F);
-            M_Name  : constant String        := Module_Name.Get (Addr'Access);
+            Load_Addr : aliased System.Address;
+            M_Name  : constant String :=
+              Module_Name.Get (Addr => Traceback (F),
+                               Load_Addr => Load_Addr'Access);
             Module  : Module_Cache;
             Success : Boolean;
          begin
-            Init_Module (Module, Success, M_Name, System.Null_Address);
+            Init_Module (Module, Success, M_Name, Load_Addr);
             if Success then
                Multi_Module_Symbolic_Traceback
                  (Traceback,
index 49b73b680a9e6484d1cae65c27bf2657e5edc09d..c361afa898241077e4e7e0c73a0634af6a4ca743 100644 (file)
@@ -32,8 +32,6 @@
 --  This is the GNU/Linux specific version of this package
 with Interfaces.C;              use Interfaces.C;
 
-with System.Address_Operations; use System.Address_Operations;
-
 separate (System.Traceback.Symbolic)
 
 package body Module_Name is
@@ -134,7 +132,10 @@ package body Module_Name is
    -- Get --
    ---------
 
-   function Get (Addr : access System.Address) return String is
+   function Get (Addr : System.Address;
+                 Load_Addr : access System.Address)
+     return String
+   is
 
       --  Dl_info record for Linux, used to get sym reloc offset
 
@@ -154,13 +155,15 @@ package body Module_Name is
       info : aliased Dl_info;
 
    begin
-      if dladdr (Addr.all, info'Access) /= 0 then
+      Load_Addr.all := System.Null_Address;
+
+      if dladdr (Addr, info'Access) /= 0 then
 
          --  If we have a shared library we need to adjust the address to
          --  be relative to the base address of the library.
 
          if Is_Shared_Lib (info.dli_fbase) then
-            Addr.all := SubA (Addr.all, info.dli_fbase);
+            Load_Addr.all := info.dli_fbase;
          end if;
 
          return Value (info.dli_fname);
index 3205c0a83fecdbe5fdda405a0c095606c829da1c..d2f260f56661bc2b87c3a8180e88bd2077074f1b 100644 (file)
@@ -50,15 +50,20 @@ package body Module_Name is
    -- Get --
    ---------
 
-   function Get (Addr : access System.Address) return String is
+   function Get (Addr : System.Address;
+                 Load_Addr : access System.Address)
+     return String
+   is
       Res     : DWORD;
       hModule : aliased HANDLE;
       Path    : String (1 .. 1_024);
 
    begin
+      Load_Addr.all := System.Null_Address;
+
       if GetModuleHandleEx
            (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
-            Addr.all,
+            Addr,
             hModule'Access) = Win32.TRUE
       then
          Res := GetModuleFileName (hModule, Path'Address, Path'Length);
index 434879386b465e0d78ed12b98de9939d1ebea1e7..5884eaaae46f8d99bdb4099d1b283eb4327f959f 100644 (file)
@@ -5116,76 +5116,91 @@ package body Sem_Res is
       --  statement.
 
       if Nkind (N) = N_Allocator then
+         --  Avoid coextension processing for an allocator that is the
+         --  expansion of a build-in-place function call.
+
+         if Nkind (Original_Node (N)) = N_Allocator
+           and then Nkind (Expression (Original_Node (N))) =
+                      N_Qualified_Expression
+           and then Nkind (Expression (Expression (Original_Node (N)))) =
+                      N_Function_Call
+           and then Is_Expanded_Build_In_Place_Call
+                      (Expression (Expression (Original_Node (N))))
+         then
+            null; -- b-i-p function call case
 
-         --  An anonymous access discriminant is the definition of a
-         --  coextension.
+         else
+            --  An anonymous access discriminant is the definition of a
+            --  coextension.
 
-         if Ekind (Typ) = E_Anonymous_Access_Type
-           and then Nkind (Associated_Node_For_Itype (Typ)) =
-                      N_Discriminant_Specification
-         then
-            declare
-               Discr : constant Entity_Id :=
-                         Defining_Identifier (Associated_Node_For_Itype (Typ));
+            if Ekind (Typ) = E_Anonymous_Access_Type
+              and then Nkind (Associated_Node_For_Itype (Typ)) =
+                         N_Discriminant_Specification
+            then
+               declare
+                  Discr : constant Entity_Id :=
+                    Defining_Identifier (Associated_Node_For_Itype (Typ));
 
-            begin
-               Check_Restriction (No_Coextensions, N);
+               begin
+                  Check_Restriction (No_Coextensions, N);
 
-               --  Ada 2012 AI05-0052: If the designated type of the allocator
-               --  is limited, then the allocator shall not be used to define
-               --  the value of an access discriminant unless the discriminated
-               --  type is immutably limited.
+                  --  Ada 2012 AI05-0052: If the designated type of the
+                  --  allocator is limited, then the allocator shall not
+                  --  be used to define the value of an access discriminant
+                  --  unless the discriminated type is immutably limited.
 
-               if Ada_Version >= Ada_2012
-                 and then Is_Limited_Type (Desig_T)
-                 and then not Is_Limited_View (Scope (Discr))
-               then
-                  Error_Msg_N
-                    ("only immutably limited types can have anonymous "
-                     & "access discriminants designating a limited type", N);
-               end if;
-            end;
+                  if Ada_Version >= Ada_2012
+                    and then Is_Limited_Type (Desig_T)
+                    and then not Is_Limited_View (Scope (Discr))
+                  then
+                     Error_Msg_N
+                       ("only immutably limited types can have anonymous "
+                        & "access discriminants designating a limited type",
+                        N);
+                  end if;
+               end;
 
-            --  Avoid marking an allocator as a dynamic coextension if it is
-            --  within a static construct.
+               --  Avoid marking an allocator as a dynamic coextension if it is
+               --  within a static construct.
 
-            if not Is_Static_Coextension (N) then
-               Set_Is_Dynamic_Coextension (N);
+               if not Is_Static_Coextension (N) then
+                  Set_Is_Dynamic_Coextension (N);
 
-               --  ??? We currently do not handle finalization and deallocation
-               --  of coextensions properly so let's at least warn the user
-               --  about it.
+                  --  ??? We currently do not handle finalization and
+                  --  deallocation of coextensions properly so let's at
+                  --  least warn the user about it.
 
-               if Is_Controlled (Desig_T) then
-                  Error_Msg_N
-                    ("??coextension will not be finalized when its "
-                     & "associated owner is deallocated or finalized", N);
-               else
-                  Error_Msg_N
-                    ("??coextension will not be deallocated when its "
-                     & "associated owner is deallocated", N);
+                  if Is_Controlled (Desig_T) then
+                     Error_Msg_N
+                       ("??coextension will not be finalized when its "
+                        & "associated owner is deallocated or finalized", N);
+                  else
+                     Error_Msg_N
+                       ("??coextension will not be deallocated when its "
+                        & "associated owner is deallocated", N);
+                  end if;
                end if;
-            end if;
 
-         --  Cleanup for potential static coextensions
+            --  Cleanup for potential static coextensions
 
-         else
-            Set_Is_Dynamic_Coextension (N, False);
-            Set_Is_Static_Coextension  (N, False);
+            else
+               Set_Is_Dynamic_Coextension (N, False);
+               Set_Is_Static_Coextension  (N, False);
 
-            --  ??? It seems we also do not properly finalize anonymous
-            --  access-to-controlled objects within their declared scope and
-            --  instead finalize them with their associated unit. Warn the
-            --  user about it here.
+               --  ??? It seems we also do not properly finalize anonymous
+               --  access-to-controlled objects within their declared scope and
+               --  instead finalize them with their associated unit. Warn the
+               --  user about it here.
 
-            if Ekind (Typ) = E_Anonymous_Access_Type
-              and then Is_Controlled_Active (Desig_T)
-            then
-               Error_Msg_N
-                 ("??object designated by anonymous access object might not "
-                  & "be finalized until its enclosing library unit goes out "
-                  & "of scope", N);
-               Error_Msg_N ("\use named access type instead", N);
+               if Ekind (Typ) = E_Anonymous_Access_Type
+                 and then Is_Controlled_Active (Desig_T)
+               then
+                  Error_Msg_N
+                    ("??object designated by anonymous access object might "
+                     & "not be finalized until its enclosing library unit "
+                     & "goes out of scope", N);
+                  Error_Msg_N ("\use named access type instead", N);
+               end if;
             end if;
          end if;
       end if;