exp_ch3.adb (Expand_N_Object_Declaration): If the object has a class-wide type and...

2013-01-03  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): If the object has
	a class-wide type and a renaming declaration is created for it,
	preserve entity chain, which already contains generated internal
	types. This ensures that freezing actions are properly generated
	for all objects declared subsequently in the same scope, and
	that debugging information is generated for them.
	* sem_util.adb, sem_util.ads (we): New debugging routine, to
	display entity chain of a given scope.

From-SVN: r194843

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5ecac2e8dd1dd0c63b27125cfd90ae1da0f0f9ce..ad2c2686a8d525db2472d50750579d9fec1b2519 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2013-01-03  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch3.adb (Expand_N_Object_Declaration): If the object has
+       a class-wide type and a renaming declaration is created for it,
+       preserve entity chain, which already contains generated internal
+       types. This ensures that freezing actions are properly generated
+       for all objects declared subsequently in the same scope, and
+       that debugging information is generated for them.
+       * sem_util.adb, sem_util.ads (we): New debugging routine, to
+       display entity chain of a given scope.
+
 2013-01-03  Robert Dewar  <dewar@adacore.com>
 
        * exp_intr.adb: Minor reformatting.

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 096d14e75033cf3bc665b547a7ae9e7c1ff74db0..f33d0f75d424ba03cb15fa9d5182684d4120742b 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5315,33 +5315,38 @@ package body Exp_Ch3 is
                       Subtype_Mark        => New_Occurrence_Of (Typ, Loc),
                       Name => Convert_Tag_To_Interface (Typ, Tag_Comp)));
 
-                  --  If the original entity comes from source, then mark the
-                  --  new entity as needing debug information, even though it's
-                  --  defined by a generated renaming that does not come from
-                  --  source, so that Materialize_Entity will be set on the
-                  --  entity when Debug_Renaming_Declaration is called during
-                  --  analysis.
-
-                  if Comes_From_Source (Def_Id) then
-                     Set_Debug_Info_Needed (Defining_Identifier (N));
-                  end if;
-
                   Analyze (N, Suppress => All_Checks);
 
                   --  Replace internal identifier of rewritten node by the
                   --  identifier found in the sources. We also have to exchange
                   --  entities containing their defining identifiers to ensure
                   --  the correct replacement of the object declaration by this
-                  --  object renaming declaration ---because these identifiers
+                  --  object renaming declaration because these identifiers
                   --  were previously added by Enter_Name to the current scope.
                   --  We must preserve the homonym chain of the source entity
                   --  as well. We must also preserve the kind of the entity,
-                  --  which may be a constant.
+                  --  which may be a constant. Preserve entity chain because
+                  --  itypes may have been generated already, and the full
+                  --  chain must be preserved for final freezing. Finally,
+                  --  Preserve Comes_From_Source setting, so that debugging
+                  --  and cross-referencing information is properly kept.
+
+                  declare
+                     New_Id    : constant Entity_Id := Defining_Identifier (N);
+                     Next_Temp : constant Entity_Id := Next_Entity (New_Id);
+                     S_Flag    : constant Boolean   :=
+                                   Comes_From_Source (Def_Id);
 
-                  Set_Chars (Defining_Identifier (N), Chars (Def_Id));
-                  Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
-                  Set_Ekind (Defining_Identifier (N), Ekind (Def_Id));
-                  Exchange_Entities (Defining_Identifier (N), Def_Id);
+                  begin
+                     Set_Next_Entity (New_Id, Next_Entity (Def_Id));
+                     Set_Next_Entity (Def_Id, Next_Temp);
+                     Set_Chars (Defining_Identifier (N), Chars (Def_Id));
+                     Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
+                     Set_Ekind (Defining_Identifier (N), Ekind (Def_Id));
+                     Set_Comes_From_Source (Def_Id, False);
+                     Exchange_Entities (Defining_Identifier (N), Def_Id);
+                     Set_Comes_From_Source (Def_Id, S_Flag);
+                  end;
                end;
             end if;
 

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 4437a16aa6e7e3364e723c56aa02cedcd8bdd741..50758e33a51b45a06888e6a50c0ba28ab91084b4 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -8531,4 +8531,21 @@ package body Sem_Ch8 is
       end loop;
    end ws;
 
+   --------
+   -- we --
+   --------
+
+   procedure we (S : Entity_Id) is
+      E : Entity_Id;
+   begin
+      E := First_Entity (S);
+      while Present (E) loop
+         Write_Int (Int (E));
+         Write_Str (" === ");
+         Write_Name (Chars (E));
+         Write_Eol;
+
+         Next_Entity (E);
+      end loop;
+   end we;
 end Sem_Ch8;

diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads
index 922b282cdfa53059752fefaa97c7da0f1ad2d437..195c03bd3a915a9c5d3fe53956edf61d8e31c0bc 100644 (file)
--- a/gcc/ada/sem_ch8.ads
+++ b/gcc/ada/sem_ch8.ads
@@ -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- --
@@ -169,4 +169,7 @@ package Sem_Ch8 is
    procedure ws;
    --  Debugging routine for use in gdb: dump all entities on scope stack
 
+   procedure we (S : Entity_Id);
+   --  Debugging routine for use in gdb: dump all entities in given scope
+
 end Sem_Ch8;