exp_ch4.adb (Has_Unconstrained_UU_Component): Use the base type in order to retrieve the component list of the type...

2005-03-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Has_Unconstrained_UU_Component): Use the base type in
	order to retrieve the component list of the type, before examining
	individual components.

	* sem_type.adb (Covers): Types are compatible if one is the base type
	of the other, even though their base types might differ when private
	views are involved.

From-SVN: r97170

2 files changed, 20 insertions, 10 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 525bf67..e817156 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4077,7 +4077,7 @@ package body Exp_Ch4 is
         (Typ : Node_Id) return Boolean
       is
          Tdef  : constant Node_Id :=
-                   Type_Definition (Declaration_Node (Typ));
+                   Type_Definition (Declaration_Node (Base_Type (Typ)));
          Clist : Node_Id;
          Vpart : Node_Id;
 
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 8d0cf75..3411194 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 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- --
@@ -585,6 +585,9 @@ package body Sem_Type is
 
    function Covers (T1, T2 : Entity_Id) return Boolean is
 
+      BT1 : Entity_Id;
+      BT2 : Entity_Id;
+
       function Full_View_Covers (Typ1, Typ2 : Entity_Id) return Boolean;
       --  In an instance the proper view may not always be correct for
       --  private types, but private and full view are compatible. This
@@ -619,6 +622,10 @@ package body Sem_Type is
          else
             raise Program_Error;
          end if;
+
+      else
+         BT1 := Base_Type (T1);
+         BT2 := Base_Type (T2);
       end if;
 
       --  Simplest case: same types are compatible, and types that have the
@@ -639,7 +646,10 @@ package body Sem_Type is
       if T1 = T2 then
          return True;
 
-      elsif Base_Type (T1) = Base_Type (T2) then
+      elsif  BT1 = BT2
+        or else BT1 = T2
+        or else BT2 = T1
+      then
          if not Is_Generic_Actual_Type (T1) then
             return True;
          else
@@ -712,9 +722,9 @@ package body Sem_Type is
       --  An Access_To_Subprogram is compatible with itself, or with an
       --  anonymous type created for an attribute reference Access.
 
-      elsif (Ekind (Base_Type (T1)) = E_Access_Subprogram_Type
+      elsif (Ekind (BT1) = E_Access_Subprogram_Type
                or else
-             Ekind (Base_Type (T1)) = E_Access_Protected_Subprogram_Type)
+             Ekind (BT1) = E_Access_Protected_Subprogram_Type)
         and then Is_Access_Type (T2)
         and then (not Comes_From_Source (T1)
                    or else not Comes_From_Source (T2))
@@ -732,9 +742,9 @@ package body Sem_Type is
       --  with itself, or with an anonymous type created for an attribute
       --  reference Access.
 
-      elsif (Ekind (Base_Type (T1)) = E_Anonymous_Access_Subprogram_Type
+      elsif (Ekind (BT1) = E_Anonymous_Access_Subprogram_Type
                or else
-             Ekind (Base_Type (T1))
+             Ekind (BT1)
                       = E_Anonymous_Access_Protected_Subprogram_Type)
         and then Is_Access_Type (T2)
         and then (not Comes_From_Source (T1)
@@ -768,14 +778,14 @@ package body Sem_Type is
          return Covers (Corresponding_Remote_Type (T2), T1);
 
       elsif Ekind (T2) = E_Access_Attribute_Type
-        and then (Ekind (Base_Type (T1)) = E_General_Access_Type
-              or else Ekind (Base_Type (T1)) = E_Access_Type)
+        and then (Ekind (BT1) = E_General_Access_Type
+                    or else Ekind (BT1) = E_Access_Type)
         and then Covers (Designated_Type (T1), Designated_Type (T2))
       then
          --  If the target type is a RACW type while the source is an access
          --  attribute type, we are building a RACW that may be exported.
 
-         if Is_Remote_Access_To_Class_Wide_Type (Base_Type (T1)) then
+         if Is_Remote_Access_To_Class_Wide_Type (BT1) then
             Set_Has_RACW (Current_Sem_Unit);
          end if;