OSDN Git Service

* config/mips/mips.c (TARGET_SMALL_REGISTER_CLASSES_FOR_MODE_P): Undef.
[pf3gnuchains/gcc-fork.git] / gcc / ada / sem_type.adb
index 4612ad3..d35326e 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -35,10 +35,12 @@ with Namet;    use Namet;
 with Opt;      use Opt;
 with Output;   use Output;
 with Sem;      use Sem;
+with Sem_Aux;  use Sem_Aux;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch12; use Sem_Ch12;
 with Sem_Disp; use Sem_Disp;
+with Sem_Dist; use Sem_Dist;
 with Sem_Util; use Sem_Util;
 with Stand;    use Stand;
 with Sinfo;    use Sinfo;
@@ -55,12 +57,12 @@ package body Sem_Type is
    --  The following data structures establish a mapping between nodes and
    --  their interpretations. An overloaded node has an entry in Interp_Map,
    --  which in turn contains a pointer into the All_Interp array. The
-   --  interpretations of a given node are contiguous in All_Interp. Each
-   --  set of interpretations is terminated with the marker No_Interp.
-   --  In order to speed up the retrieval of the interpretations of an
-   --  overloaded node, the Interp_Map table is accessed by means of a simple
-   --  hashing scheme, and the entries in Interp_Map are chained. The heads
-   --  of clash lists are stored in array Headers.
+   --  interpretations of a given node are contiguous in All_Interp. Each set
+   --  of interpretations is terminated with the marker No_Interp. In order to
+   --  speed up the retrieval of the interpretations of an overloaded node, the
+   --  Interp_Map table is accessed by means of a simple hashing scheme, and
+   --  the entries in Interp_Map are chained. The heads of clash lists are
+   --  stored in array Headers.
 
    --              Headers        Interp_Map          All_Interp
 
@@ -130,16 +132,15 @@ package body Sem_Type is
    -- Operator Overloading --
    --------------------------
 
-   --  The visibility of operators is handled differently from that of
-   --  other entities. We do not introduce explicit versions of primitive
-   --  operators for each type definition. As a result, there is only one
-   --  entity corresponding to predefined addition on all numeric types, etc.
-   --  The back-end resolves predefined operators according to their type.
-   --  The visibility of primitive operations then reduces to the visibility
-   --  of the resulting type:  (a + b) is a legal interpretation of some
-   --  primitive operator + if the type of the result (which must also be
-   --  the type of a and b) is directly visible (i.e. either immediately
-   --  visible or use-visible.)
+   --  The visibility of operators is handled differently from that of other
+   --  entities. We do not introduce explicit versions of primitive operators
+   --  for each type definition. As a result, there is only one entity
+   --  corresponding to predefined addition on all numeric types, etc. The
+   --  back-end resolves predefined operators according to their type. The
+   --  visibility of primitive operations then reduces to the visibility of the
+   --  resulting type: (a + b) is a legal interpretation of some primitive
+   --  operator + if the type of the result (which must also be the type of a
+   --  and b) is directly visible (either immediately visible or use-visible).
 
    --  User-defined operators are treated like other functions, but the
    --  visibility of these user-defined operations must be special-cased
@@ -310,8 +311,7 @@ package body Sem_Type is
          end loop;
 
          All_Interp.Table (All_Interp.Last) := (Name, Typ, Abstr_Op);
-         All_Interp.Increment_Last;
-         All_Interp.Table (All_Interp.Last) := No_Interp;
+         All_Interp.Append (No_Interp);
       end Add_Entry;
 
       ----------------------------
@@ -403,10 +403,9 @@ package body Sem_Type is
             return;
          end if;
 
-      --  In an instance, an abstract non-dispatching operation cannot
-      --  be a candidate interpretation, because it could not have been
-      --  one in the generic (it may be a spurious overloading in the
-      --  instance).
+      --  In an instance, an abstract non-dispatching operation cannot be a
+      --  candidate interpretation, because it could not have been one in the
+      --  generic (it may be a spurious overloading in the instance).
 
       elsif In_Instance
         and then Is_Overloadable (E)
@@ -415,29 +414,35 @@ package body Sem_Type is
       then
          return;
 
-      --  An inherited interface operation that is implemented by some
-      --  derived type does not participate in overload resolution, only
-      --  the implementation operation does.
+      --  An inherited interface operation that is implemented by some derived
+      --  type does not participate in overload resolution, only the
+      --  implementation operation does.
 
       elsif Is_Hidden (E)
         and then Is_Subprogram (E)
-        and then Present (Abstract_Interface_Alias (E))
+        and then Present (Interface_Alias (E))
       then
          --  Ada 2005 (AI-251): If this primitive operation corresponds with
-         --  an inmediate ancestor interface there is no need to add it to the
-         --  list of interpretations; the corresponding aliased primitive is
+         --  an immediate ancestor interface there is no need to add it to the
+         --  list of interpretations. The corresponding aliased primitive is
          --  also in this list of primitive operations and will be used instead
-         --  because otherwise we have a dummy between the two subprograms that
-         --  are in fact the same.
+         --  because otherwise we have a dummy ambiguity between the two
+         --  subprograms which are in fact the same.
 
          if not Is_Ancestor
-                  (Find_Dispatching_Type (Abstract_Interface_Alias (E)),
+                  (Find_Dispatching_Type (Interface_Alias (E)),
                    Find_Dispatching_Type (E))
          then
-            Add_One_Interp (N, Abstract_Interface_Alias (E), T);
+            Add_One_Interp (N, Interface_Alias (E), T);
          end if;
 
          return;
+
+      --  Calling stubs for an RACW operation never participate in resolution,
+      --  they are executed only through dispatching calls.
+
+      elsif Is_RACW_Stub_Type_Operation (E) then
+         return;
       end if;
 
       --  If this is the first interpretation of N, N has type Any_Type.
@@ -505,8 +510,8 @@ package body Sem_Type is
             end;
 
          else
-            --  Overloaded prefix in indexed or selected component,
-            --  or call whose name is an expression or another call.
+            --  Overloaded prefix in indexed or selected component, or call
+            --  whose name is an expression or another call.
 
             Add_Entry (Etype (N), Etype (N));
          end if;
@@ -530,6 +535,7 @@ package body Sem_Type is
             Write_Entity_Info (All_Interp.Table (J). Nam, " ");
          else
             Write_Str ("No Interp");
+            Write_Eol;
          end if;
 
          Write_Str ("=================");
@@ -626,8 +632,7 @@ package body Sem_Type is
                      then
                         All_Interp.Table (All_Interp.Last) :=
                           (H, Etype (H), Empty);
-                        All_Interp.Increment_Last;
-                        All_Interp.Table (All_Interp.Last) := No_Interp;
+                        All_Interp.Append (No_Interp);
                         goto Next_Homograph;
 
                      elsif Scope (H) /= Standard_Standard then
@@ -641,7 +646,7 @@ package body Sem_Type is
                Add_One_Interp (N, H, Etype (H));
 
                if Debug_Flag_E then
-                  Write_Str ("Add overloaded Interpretation ");
+                  Write_Str ("Add overloaded interpretation ");
                   Write_Int (Int (H));
                   Write_Eol;
                end if;
@@ -680,9 +685,15 @@ package body Sem_Type is
 
       if All_Interp.Last = First_Interp + 1 then
 
-         --  The original interpretation is in fact not overloaded
+         --  The final interpretation is in fact not overloaded. Note that the
+         --  unique legal interpretation may or may not be the original one,
+         --  so we need to update N's entity and etype now, because once N
+         --  is marked as not overloaded it is also expected to carry the
+         --  proper interpretation.
 
          Set_Is_Overloaded (N, False);
+         Set_Entity (N, All_Interp.Table (First_Interp).Nam);
+         Set_Etype  (N, All_Interp.Table (First_Interp).Typ);
       end if;
    end Collect_Interps;
 
@@ -721,7 +732,7 @@ package body Sem_Type is
    begin
       --  If either operand missing, then this is an error, but ignore it (and
       --  pretend we have a cover) if errors already detected, since this may
-      --  simply mean we have malformed trees.
+      --  simply mean we have malformed trees or a semantic error upstream.
 
       if No (T1) or else No (T2) then
          if Total_Errors_Detected /= 0 then
@@ -733,6 +744,18 @@ package body Sem_Type is
       else
          BT1 := Base_Type (T1);
          BT2 := Base_Type (T2);
+
+         --  Handle underlying view of records with unknown discriminants
+         --  using the original entity that motivated the construction of
+         --  this underlying record view (see Build_Derived_Private_Type).
+
+         if Is_Underlying_Record_View (BT1) then
+            BT1 := Underlying_Record_View (BT1);
+         end if;
+
+         if Is_Underlying_Record_View (BT2) then
+            BT2 := Underlying_Record_View (BT2);
+         end if;
       end if;
 
       --  Simplest case: same types are compatible, and types that have the
@@ -753,7 +776,7 @@ package body Sem_Type is
       if T1 = T2 then
          return True;
 
-      elsif  BT1 = BT2
+      elsif BT1 = BT2
         or else BT1 = T2
         or else BT2 = T1
       then
@@ -768,9 +791,9 @@ package body Sem_Type is
                      or else Scope (T1) /= Scope (T2));
          end if;
 
-      --  Literals are compatible with types in  a given "class"
+      --  Literals are compatible with types in a given "class"
 
-      elsif (T2 = Universal_Integer and then Is_Integer_Type (T1))
+      elsif     (T2 = Universal_Integer and then Is_Integer_Type (T1))
         or else (T2 = Universal_Real    and then Is_Real_Type (T1))
         or else (T2 = Universal_Fixed   and then Is_Fixed_Point_Type (T1))
         or else (T2 = Any_Fixed         and then Is_Fixed_Point_Type (T1))
@@ -780,7 +803,8 @@ package body Sem_Type is
       then
          return True;
 
-      --  The context may be class wide
+      --  The context may be class wide, and a class-wide type is
+      --  compatible with any member of the class.
 
       elsif Is_Class_Wide_Type (T1)
         and then Is_Ancestor (Root_Type (T1), T2)
@@ -793,8 +817,8 @@ package body Sem_Type is
       then
          return True;
 
-      --  Ada 2005 (AI-345): A class-wide abstract interface type T1 covers a
-      --  task_type or protected_type implementing T1
+      --  Ada 2005 (AI-345): A class-wide abstract interface type covers a
+      --  task_type or protected_type that implements the interface.
 
       elsif Ada_Version >= Ada_05
         and then Is_Class_Wide_Type (T1)
@@ -836,9 +860,9 @@ package body Sem_Type is
             --  Note: test for presence of E is defense against previous error.
 
             if Present (E)
-              and then Present (Abstract_Interfaces (E))
+              and then Present (Interfaces (E))
             then
-               Elmt := First_Elmt (Abstract_Interfaces (E));
+               Elmt := First_Elmt (Interfaces (E));
                while Present (Elmt) loop
                   if Is_Ancestor (Etype (T1), Node (Elmt)) then
                      return True;
@@ -861,7 +885,10 @@ package body Sem_Type is
       then
          return True;
 
-      --  Some contexts require a class of types rather than a specific type
+      --  Some contexts require a class of types rather than a specific type.
+      --  For example, conditions require any boolean type, fixed point
+      --  attributes require some real type, etc. The built-in types Any_XXX
+      --  represent these classes.
 
       elsif (T1 = Any_Integer and then Is_Integer_Type (T2))
         or else (T1 = Any_Boolean and then Is_Boolean_Type (T2))
@@ -931,7 +958,7 @@ package body Sem_Type is
 
       --  The context can be a remote access type, and the expression the
       --  corresponding source type declared in a categorized package, or
-      --  viceversa.
+      --  vice versa.
 
       elsif Is_Record_Type (T1)
         and then (Is_Remote_Call_Interface (T1)
@@ -940,6 +967,8 @@ package body Sem_Type is
       then
          return Covers (Corresponding_Remote_Type (T1), T2);
 
+      --  and conversely.
+
       elsif Is_Record_Type (T2)
         and then (Is_Remote_Call_Interface (T2)
                    or else Is_Remote_Types (T2))
@@ -947,9 +976,30 @@ package body Sem_Type is
       then
          return Covers (Corresponding_Remote_Type (T2), T1);
 
+      --  Synchronized types are represented at run time by their corresponding
+      --  record type. During expansion one is replaced with the other, but
+      --  they are compatible views of the same type.
+
+      elsif Is_Record_Type (T1)
+        and then Is_Concurrent_Type (T2)
+        and then Present (Corresponding_Record_Type (T2))
+      then
+         return Covers (T1, Corresponding_Record_Type (T2));
+
+      elsif Is_Concurrent_Type (T1)
+        and then Present (Corresponding_Record_Type (T1))
+        and then Is_Record_Type (T2)
+      then
+         return Covers (Corresponding_Record_Type (T1), T2);
+
+      --  During analysis, an attribute reference 'Access has a special type
+      --  kind: Access_Attribute_Type, to be replaced eventually with the type
+      --  imposed by context.
+
       elsif Ekind (T2) = E_Access_Attribute_Type
         and then (Ekind (BT1) = E_General_Access_Type
-                    or else Ekind (BT1) = E_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
@@ -961,6 +1011,8 @@ package body Sem_Type is
 
          return True;
 
+      --  Ditto for allocators, which eventually resolve to the context type
+
       elsif Ekind (T2) = E_Allocator_Type
         and then Is_Access_Type (T1)
       then
@@ -985,7 +1037,7 @@ package body Sem_Type is
       --  A packed array type covers its corresponding non-packed type. This is
       --  not legitimate Ada, but allows the omission of a number of otherwise
       --  useless unchecked conversions, and since this can only arise in
-      --  (known correct) expanded code, no harm is done
+      --  (known correct) expanded code, no harm is done.
 
       elsif Is_Array_Type (T2)
         and then Is_Packed (T2)
@@ -1019,7 +1071,7 @@ package body Sem_Type is
          return True;
 
       elsif Is_Type (T1)
-        and then  Is_Generic_Actual_Type (T1)
+        and then Is_Generic_Actual_Type (T1)
         and then Full_View_Covers (T2, T1)
       then
          return True;
@@ -1042,7 +1094,7 @@ package body Sem_Type is
          return True;
 
       --  Ada 2005 (AI-50217): Additional branches to make the shadow entity
-      --  compatible with its real entity.
+      --  obtained through a limited_with compatible with its real entity.
 
       elsif From_With_Type (T1) then
 
@@ -1064,7 +1116,7 @@ package body Sem_Type is
 
          --  If units in the context have Limited_With clauses on each other,
          --  either type might have a limited view. Checks performed elsewhere
-         --  verify that the context type is the non-limited view.
+         --  verify that the context type is the nonlimited view.
 
          if Is_Incomplete_Type (T2) then
             return Covers (T1, Get_Full_View (Non_Limited_View (T2)));
@@ -1088,7 +1140,7 @@ package body Sem_Type is
 
       --  Ada 2005 (AI-423): Coverage of formal anonymous access types
       --  and actual anonymous access types in the context of generic
-      --  instantiation. We have the following situation:
+      --  instantiations. We have the following situation:
 
       --     generic
       --        type Formal is private;
@@ -1110,7 +1162,7 @@ package body Sem_Type is
       then
          return True;
 
-      --  Otherwise it doesn't cover!
+      --  Otherwise, types are not compatible!
 
       else
          return False;
@@ -1124,8 +1176,7 @@ package body Sem_Type is
    function Disambiguate
      (N      : Node_Id;
       I1, I2 : Interp_Index;
-      Typ    : Entity_Id)
-      return   Interp
+      Typ    : Entity_Id) return Interp
    is
       I           : Interp_Index;
       It          : Interp;
@@ -1138,13 +1189,6 @@ package body Sem_Type is
       --  Determine whether one of the candidates is an operation inherited by
       --  a type that is derived from an actual in an instantiation.
 
-      function In_Generic_Actual (Exp : Node_Id) return Boolean;
-      --  Determine whether the expression is part of a generic actual. At
-      --  the time the actual is resolved the scope is already that of the
-      --  instance, but conceptually the resolution of the actual takes place
-      --  in the enclosing context, and no special disambiguation rules should
-      --  be applied.
-
       function Is_Actual_Subprogram (S : Entity_Id) return Boolean;
       --  Determine whether a subprogram is an actual in an enclosing instance.
       --  An overloading between such a subprogram and one declared outside the
@@ -1181,34 +1225,6 @@ package body Sem_Type is
       --  for special handling of expressions with universal operands, see
       --  comments to Has_Abstract_Interpretation below.
 
-      ------------------------
-      --  In_Generic_Actual --
-      ------------------------
-
-      function In_Generic_Actual (Exp : Node_Id) return Boolean is
-         Par : constant Node_Id := Parent (Exp);
-
-      begin
-         if No (Par) then
-            return False;
-
-         elsif Nkind (Par) in N_Declaration then
-            if Nkind (Par) = N_Object_Declaration
-              or else Nkind (Par) = N_Object_Renaming_Declaration
-            then
-               return Present (Corresponding_Generic_Association (Par));
-            else
-               return False;
-            end if;
-
-         elsif Nkind (Par) in N_Statement_Other_Than_Procedure_Call then
-            return False;
-
-         else
-            return In_Generic_Actual (Parent (Par));
-         end if;
-      end In_Generic_Actual;
-
       ---------------------------
       -- Inherited_From_Actual --
       ---------------------------
@@ -1237,7 +1253,7 @@ package body Sem_Type is
          return In_Open_Scopes (Scope (S))
            and then
              (Is_Generic_Instance (Scope (S))
-                or else Is_Wrapper_Package (Scope (S)));
+               or else Is_Wrapper_Package (Scope (S)));
       end Is_Actual_Subprogram;
 
       -------------
@@ -1251,8 +1267,7 @@ package body Sem_Type is
          return T1 = T2
            or else
              (Is_Numeric_Type (T2)
-               and then
-             (T1 = Universal_Real or else T1 = Universal_Integer));
+               and then (T1 = Universal_Real or else T1 = Universal_Integer));
       end Matches;
 
       ------------------------
@@ -1394,9 +1409,8 @@ package body Sem_Type is
                   elsif Present (Act2)
                     and then Nkind (Act2) in N_Op
                     and then Is_Overloaded (Act2)
-                    and then (Nkind (Right_Opnd (Act2)) = N_Integer_Literal
-                                or else
-                              Nkind (Right_Opnd (Act2)) = N_Real_Literal)
+                    and then Nkind_In (Right_Opnd (Act2), N_Integer_Literal,
+                                                          N_Real_Literal)
                     and then Has_Compatible_Type (Act2, Standard_Boolean)
                   then
                      --  The preference rule on the first actual is not
@@ -1409,15 +1423,36 @@ package body Sem_Type is
                   end if;
 
                elsif Is_Numeric_Type (Etype (F1))
-                 and then
-                   (Has_Abstract_Interpretation (Act1)
-                     or else Has_Abstract_Interpretation (Act2))
+                 and then Has_Abstract_Interpretation (Act1)
                then
-                  if It = Disambiguate.It1 then
-                     return Disambiguate.It2;
-                  elsif It = Disambiguate.It2 then
-                     return Disambiguate.It1;
-                  end if;
+                  --  Current interpretation is not the right one because it
+                  --  expects a numeric operand. Examine all the other ones.
+
+                  declare
+                     I  : Interp_Index;
+                     It : Interp;
+
+                  begin
+                     Get_First_Interp (N, I, It);
+                     while Present (It.Typ) loop
+                        if
+                          not Is_Numeric_Type (Etype (First_Formal (It.Nam)))
+                        then
+                           if No (Act2)
+                             or else not Has_Abstract_Interpretation (Act2)
+                             or else not
+                               Is_Numeric_Type
+                                 (Etype (Next_Formal (First_Formal (It.Nam))))
+                           then
+                              return It;
+                           end if;
+                        end if;
+
+                        Get_Next_Interp (I, It);
+                     end loop;
+
+                     return No_Interp;
+                  end;
                end if;
             end if;
 
@@ -1514,8 +1549,8 @@ package body Sem_Type is
       end if;
 
       --  Check for overloaded CIL convention stuff because the CIL libraries
-      --  do sick things like Console.WriteLine where it matches
-      --  two different overloads, so just pick the first ???
+      --  do sick things like Console.Write_Line where it matches two different
+      --  overloads, so just pick the first ???
 
       if Convention (Nam1) = Convention_CIL
         and then Convention (Nam2) = Convention_CIL
@@ -1635,6 +1670,39 @@ package body Sem_Type is
       elsif Nkind (N) = N_Range then
          return It1;
 
+      --  Implement AI05-105: A renaming declaration with an access
+      --  definition must resolve to an anonymous access type. This
+      --  is a resolution rule and can be used to disambiguate.
+
+      elsif Nkind (Parent (N)) = N_Object_Renaming_Declaration
+        and then Present (Access_Definition (Parent (N)))
+      then
+         if Ekind (It1.Typ) = E_Anonymous_Access_Type
+              or else
+            Ekind (It1.Typ) = E_Anonymous_Access_Subprogram_Type
+         then
+            if Ekind (It2.Typ) = Ekind (It1.Typ) then
+
+               --  True ambiguity
+
+               return No_Interp;
+
+            else
+               return It1;
+            end if;
+
+         elsif Ekind (It2.Typ) = E_Anonymous_Access_Type
+                 or else
+               Ekind (It2.Typ) = E_Anonymous_Access_Subprogram_Type
+         then
+            return It2;
+
+         --  No legal interpretation
+
+         else
+            return No_Interp;
+         end if;
+
       --  If two user defined-subprograms are visible, it is a true ambiguity,
       --  unless one of them is an entry and the context is a conditional or
       --  timed entry call, or unless we are within an instance and this is
@@ -1981,7 +2049,10 @@ package body Sem_Type is
       Form_Parm : Node_Id;
 
    begin
-      if Is_Overloaded (N) then
+      --  Why is check on E needed below ???
+      --  In any case this para needs comments ???
+
+      if Is_Overloaded (N) and then Is_Overloadable (E) then
          Act_Parm  := First_Actual (N);
          Form_Parm := First_Formal (E);
          while Present (Act_Parm)
@@ -2036,7 +2107,7 @@ package body Sem_Type is
       end if;
 
       Map_Ptr := Headers (Hash (O_N));
-      while Present (Interp_Map.Table (Map_Ptr).Node) loop
+      while Map_Ptr /= No_Entry loop
          if Interp_Map.Table (Map_Ptr).Node = O_N then
             Int_Ind := Interp_Map.Table (Map_Ptr).Index;
             It := All_Interp.Table (Int_Ind);
@@ -2067,9 +2138,8 @@ package body Sem_Type is
    -------------------------
 
    function Has_Compatible_Type
-     (N    : Node_Id;
-      Typ  : Entity_Id)
-      return Boolean
+     (N   : Node_Id;
+      Typ : Entity_Id) return Boolean
    is
       I  : Interp_Index;
       It : Interp;
@@ -2085,16 +2155,23 @@ package body Sem_Type is
          return
            Covers (Typ, Etype (N))
 
-            --  Ada 2005 (AI-345) The context may be a synchronized interface.
+            --  Ada 2005 (AI-345): The context may be a synchronized interface.
             --  If the type is already frozen use the corresponding_record
             --  to check whether it is a proper descendant.
 
            or else
-             (Is_Concurrent_Type (Etype (N))
+             (Is_Record_Type (Typ)
+                and then Is_Concurrent_Type (Etype (N))
                 and then Present (Corresponding_Record_Type (Etype (N)))
                 and then Covers (Typ, Corresponding_Record_Type (Etype (N))))
 
            or else
+             (Is_Concurrent_Type (Typ)
+                and then Is_Record_Type (Etype (N))
+                and then Present (Corresponding_Record_Type (Typ))
+                and then Covers (Corresponding_Record_Type (Typ), Etype (N)))
+
+           or else
              (not Is_Tagged_Type (Typ)
                 and then Ekind (Typ) /= E_Anonymous_Access_Type
                 and then Covers (Etype (N), Typ));
@@ -2235,11 +2312,11 @@ package body Sem_Type is
          end if;
 
          loop
-            if Present (Abstract_Interfaces (E))
-              and then Present (Abstract_Interfaces (E))
-              and then not Is_Empty_Elmt_List (Abstract_Interfaces (E))
+            if Present (Interfaces (E))
+              and then Present (Interfaces (E))
+              and then not Is_Empty_Elmt_List (Interfaces (E))
             then
-               Elmt := First_Elmt (Abstract_Interfaces (E));
+               Elmt := First_Elmt (Interfaces (E));
                while Present (Elmt) loop
                   AI := Node (Elmt);
 
@@ -2280,8 +2357,10 @@ package body Sem_Type is
    --  Start of processing for Interface_Present_In_Ancestor
 
    begin
+      --  Iface might be a class-wide subtype, so we have to apply Base_Type
+
       if Is_Class_Wide_Type (Iface) then
-         Iface_Typ := Etype (Iface);
+         Iface_Typ := Etype (Base_Type (Iface));
       else
          Iface_Typ := Iface;
       end if;
@@ -2318,7 +2397,7 @@ package body Sem_Type is
                   if Etype (AI) = Iface_Typ then
                      return True;
 
-                  elsif Present (Abstract_Interfaces (Etype (AI)))
+                  elsif Present (Interfaces (Etype (AI)))
                      and then Iface_Present_In_Ancestor (Etype (AI))
                   then
                      return True;
@@ -2392,7 +2471,7 @@ package body Sem_Type is
          end if;
       end Check_Right_Argument;
 
-   --  Start processing for Intersect_Types
+   --  Start of processing for Intersect_Types
 
    begin
       if Etype (L) = Any_Type or else Etype (R) = Any_Type then
@@ -2438,25 +2517,71 @@ package body Sem_Type is
       return Typ;
    end Intersect_Types;
 
+   -----------------------
+   -- In_Generic_Actual --
+   -----------------------
+
+   function In_Generic_Actual (Exp : Node_Id) return Boolean is
+      Par : constant Node_Id := Parent (Exp);
+
+   begin
+      if No (Par) then
+         return False;
+
+      elsif Nkind (Par) in N_Declaration then
+         if Nkind (Par) = N_Object_Declaration then
+            return Present (Corresponding_Generic_Association (Par));
+         else
+            return False;
+         end if;
+
+      elsif Nkind (Par) = N_Object_Renaming_Declaration then
+         return Present (Corresponding_Generic_Association (Par));
+
+      elsif Nkind (Par) in N_Statement_Other_Than_Procedure_Call then
+         return False;
+
+      else
+         return In_Generic_Actual (Parent (Par));
+      end if;
+   end In_Generic_Actual;
+
    -----------------
    -- Is_Ancestor --
    -----------------
 
    function Is_Ancestor (T1, T2 : Entity_Id) return Boolean is
+      BT1 : Entity_Id;
+      BT2 : Entity_Id;
       Par : Entity_Id;
 
    begin
-      if Base_Type (T1) = Base_Type (T2) then
+      BT1 := Base_Type (T1);
+      BT2 := Base_Type (T2);
+
+      --  Handle underlying view of records with unknown discriminants
+      --  using the original entity that motivated the construction of
+      --  this underlying record view (see Build_Derived_Private_Type).
+
+      if Is_Underlying_Record_View (BT1) then
+         BT1 := Underlying_Record_View (BT1);
+      end if;
+
+      if Is_Underlying_Record_View (BT2) then
+         BT2 := Underlying_Record_View (BT2);
+      end if;
+
+      if BT1 = BT2 then
          return True;
 
       elsif Is_Private_Type (T1)
         and then Present (Full_View (T1))
-        and then Base_Type (T2) = Base_Type (Full_View (T1))
+        and then BT2 = Base_Type (Full_View (T1))
       then
          return True;
 
       else
-         Par := Etype (T2);
+         Par := Etype (BT2);
 
          loop
             --  If there was a error on the type declaration, do not recurse
@@ -2464,7 +2589,7 @@ package body Sem_Type is
             if Error_Posted (Par) then
                return False;
 
-            elsif Base_Type (T1) = Base_Type (Par)
+            elsif BT1 = Base_Type (Par)
               or else (Is_Private_Type (T1)
                          and then Present (Full_View (T1))
                          and then Base_Type (Par) = Base_Type (Full_View (T1)))
@@ -2473,7 +2598,7 @@ package body Sem_Type is
 
             elsif Is_Private_Type (Par)
               and then Present (Full_View (Par))
-              and then Full_View (Par) = Base_Type (T1)
+              and then Full_View (Par) = BT1
             then
                return True;
 
@@ -2491,9 +2616,8 @@ package body Sem_Type is
    ---------------------------
 
    function Is_Invisible_Operator
-     (N    : Node_Id;
-      T    : Entity_Id)
-      return Boolean
+     (N : Node_Id;
+      T : Entity_Id) return Boolean
    is
       Orig_Node : constant Node_Id := Original_Node (N);
 
@@ -2580,8 +2704,7 @@ package body Sem_Type is
       Map_Ptr : Int;
 
    begin
-      All_Interp.Increment_Last;
-      All_Interp.Table (All_Interp.Last) := No_Interp;
+      All_Interp.Append (No_Interp);
 
       Map_Ptr := Headers (Hash (N));
 
@@ -2704,9 +2827,8 @@ package body Sem_Type is
               and then Base_Type (T1) = Base_Type (T)
               and then Is_Numeric_Type (T);
 
-         --  for division and multiplication, a user-defined function does
-         --  not match the predefined universal_fixed operation, except in
-         --  Ada83 mode.
+         --  For division and multiplication, a user-defined function does not
+         --  match the predefined universal_fixed operation, except in Ada 83.
 
          elsif Op_Name = Name_Op_Divide then
             return (Base_Type (T1) = Base_Type (T2)
@@ -2787,7 +2909,7 @@ package body Sem_Type is
       II : Interp_Index;
 
    begin
-      --  Find end of Interp list and copy downward to erase the discarded one
+      --  Find end of interp list and copy downward to erase the discarded one
 
       II := I + 1;
       while Present (All_Interp.Table (II).Typ) loop
@@ -2798,7 +2920,7 @@ package body Sem_Type is
          All_Interp.Table (J - 1) := All_Interp.Table (J);
       end loop;
 
-      --  Back up interp. index to insure that iterator will pick up next
+      --  Back up interp index to insure that iterator will pick up next
       --  available interpretation.
 
       I := I - 1;