2005-03-08 Javier Miranda <miranda@adacore.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / exp_ch13.adb

diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 908ebd6..9cf9bb0 100644 (file)
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2002, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2005, 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- --
@@ -30,6 +30,7 @@ with Einfo;    use Einfo;
 with Exp_Ch3;  use Exp_Ch3;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Imgv; use Exp_Imgv;
+with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -92,7 +93,6 @@ package body Exp_Ch13 is
 
             declare
                Decl : constant Node_Id := Declaration_Node (Ent);
-
             begin
                if Nkind (Decl) = N_Object_Declaration
                   and then Present (Expression (Decl))
@@ -170,12 +170,11 @@ package body Exp_Ch13 is
    procedure Expand_External_Tag_Definition (N : Node_Id) is
       Loc     : constant Source_Ptr := Sloc (N);
       Ent     : constant Entity_Id  := Entity (Name (N));
-      E       : Entity_Id;
-      Old_Val : String_Id := Strval (Expr_Value_S (Expression (N)));
+      Old_Val : constant String_Id  := Strval (Expr_Value_S (Expression (N)));
       New_Val : String_Id;
+      E       : Entity_Id;
 
    begin
-
       --  For the rep clause "for x'external_tag use y" generate:
 
       --     xV : constant string := y;
@@ -244,6 +243,7 @@ package body Exp_Ch13 is
       In_Other_Scope : Boolean;
       In_Outer_Scope : Boolean;
       Decl           : Node_Id;
+      Delete         : Boolean := False;
 
    begin
       --  For object, with address clause, check alignment is OK
@@ -262,6 +262,12 @@ package body Exp_Ch13 is
 
       E_Scope := Scope (E);
 
+      --  This is an error protection against previous errors
+
+      if No (E_Scope) then
+         return;
+      end if;
+
       --  If we are freezing entities defined in protected types, they
       --  belong in the enclosing scope, given that the original type
       --  has been expanded away. The same is true for entities in task types,
@@ -312,7 +318,7 @@ package body Exp_Ch13 is
       --  If type, freeze the type
 
       if Is_Type (E) then
-         Freeze_Type (N);
+         Delete := Freeze_Type (N);
 
          --  And for enumeration type, build the enumeration tables
 
@@ -322,15 +328,18 @@ package body Exp_Ch13 is
          elsif Is_Tagged_Type (E)
            and then Is_First_Subtype (E)
          then
-
             --  Check for a definition of External_Tag, whose expansion must
-            --  be delayed until the dispatch table is built.
+            --  be delayed until the dispatch table is built. The clause
+            --  is considered only if it applies to this specific tagged
+            --  type, as opposed to one of its ancestors.
 
             declare
-               Def : Node_Id :=
-                  Get_Attribute_Definition_Clause (E, Attribute_External_Tag);
+               Def : constant Node_Id :=
+                       Get_Attribute_Definition_Clause
+                         (E, Attribute_External_Tag);
+
             begin
-               if Present (Def) then
+               if Present (Def) and then Entity (Name (Def)) = E then
                   Expand_External_Tag_Definition (Def);
                end if;
             end;
@@ -354,8 +363,9 @@ package body Exp_Ch13 is
          while Present (Decl) loop
 
             if Nkind (Decl) = N_Subprogram_Body
-              and then (Chars (Defining_Entity (Decl)) = Name_uInit_Proc
-                 or else Chars (Defining_Entity (Decl)) = Name_uAssign)
+              and then (Is_Init_Proc (Defining_Entity (Decl))
+                          or else
+                            Chars (Defining_Entity (Decl)) = Name_uAssign)
             then
                Analyze (Decl);
 
@@ -379,6 +389,13 @@ package body Exp_Ch13 is
          end loop;
       end if;
 
+      --  If we are to delete this N_Freeze_Entity, do so by rewriting so that
+      --  a loop on all nodes being inserted will work propertly.
+
+      if Delete then
+         Rewrite (N, Make_Null_Statement (Sloc (N)));
+      end if;
+
       if In_Other_Scope then
          if Ekind (Current_Scope) = E_Package then
             End_Package_Scope (E_Scope);