diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -265,6 +265,22 @@ package body Sem_Ch4 is
    --  these aspects can be achieved without larger modifications to the
    --  two-pass resolution algorithm.
 
+   function Possible_Type_For_Conditional_Expression
+     (T1, T2 : Entity_Id) return Entity_Id;
+   --  Given two types T1 and T2 that are _not_ compatible, return a type that
+   --  may still be used as the possible type of a conditional expression whose
+   --  dependent expressions, or part thereof, have type T1 and T2 respectively
+   --  during the first phase of type resolution, or Empty if such a type does
+   --  not exist.
+
+   --  The typical example is an if_expression whose then_expression is of a
+   --  tagged type and whose else_expresssion is of an extension of this type:
+   --  the types are not compatible but such an if_expression can be legal if
+   --  its expected type is the 'Class of the tagged type, so the function will
+   --  return the tagged type in this case. If the expected type turns out to
+   --  be something else, including the tagged type itself, then an error will
+   --  be given during the second phase of type resolution.
+
    procedure Remove_Abstract_Operations (N : Node_Id);
    --  Ada 2005: implementation of AI-310. An abstract non-dispatching
    --  operation is not a candidate interpretation.
@@ -1559,10 +1575,30 @@ package body Sem_Ch4 is
    -----------------------------
 
    procedure Analyze_Case_Expression (N : Node_Id) is
+      Expr      : constant Node_Id := Expression (N);
+      First_Alt : constant Node_Id := First (Alternatives (N));
+
+      First_Expr : Node_Id := Empty;
+      --  First expression in the case where there is some type information
+      --  available, i.e. there is not Any_Type everywhere, which can happen
+      --  because of some error.
+
+      Second_Expr : Node_Id := Empty;
+      --  Second expression as above
+
+      Wrong_Alt : Node_Id := Empty;
+      --  For error reporting
+
       procedure Non_Static_Choice_Error (Choice : Node_Id);
       --  Error routine invoked by the generic instantiation below when
       --  the case expression has a non static choice.
 
+      procedure Check_Next_Expression (T : Entity_Id; Alt : Node_Id);
+      --  Check one interpretation of the next expression with type T
+
+      procedure Check_Expression_Pair (T1, T2 : Entity_Id; Alt : Node_Id);
+      --  Check first expression with type T1 and next expression with type T2
+
       package Case_Choices_Analysis is new
         Generic_Analyze_Choices
           (Process_Associated_Node => No_OP);
@@ -1585,23 +1621,81 @@ package body Sem_Ch4 is
            ("choice given in case expression is not static!", Choice);
       end Non_Static_Choice_Error;
 
-      --  Local variables
+      ---------------------------
+      -- Check_Next_Expression --
+      ---------------------------
 
-      Expr      : constant Node_Id := Expression (N);
-      Alt       : Node_Id;
-      Exp_Type  : Entity_Id;
-      Exp_Btype : Entity_Id;
+      procedure Check_Next_Expression (T : Entity_Id; Alt : Node_Id) is
+         Next_Expr : constant Node_Id := Expression (Alt);
 
-      FirstX : Node_Id := Empty;
-      --  First expression in the case for which there is some type information
-      --  available, i.e. it is not Any_Type, which can happen because of some
-      --  error, or from the use of e.g. raise Constraint_Error.
+         I     : Interp_Index;
+         It    : Interp;
 
-      Others_Present : Boolean;
-      --  Indicates if Others was present
+      begin
+         if Next_Expr = First_Expr then
+            Check_Next_Expression (T, Next (Alt));
+            return;
+         end if;
 
-      Wrong_Alt : Node_Id := Empty;
-      --  For error reporting
+         --  Loop through the interpretations of the next expression
+
+         if not Is_Overloaded (Next_Expr) then
+            Check_Expression_Pair (T, Etype (Next_Expr), Alt);
+
+         else
+            Get_First_Interp (Next_Expr, I, It);
+            while Present (It.Typ) loop
+               Check_Expression_Pair (T, It.Typ, Alt);
+               Get_Next_Interp (I, It);
+            end loop;
+         end if;
+      end Check_Next_Expression;
+
+      ---------------------------
+      -- Check_Expression_Pair --
+      ---------------------------
+
+      procedure Check_Expression_Pair (T1, T2 : Entity_Id; Alt : Node_Id) is
+         Next_Expr : constant Node_Id := Expression (Alt);
+
+         T : Entity_Id;
+
+      begin
+         if Covers (T1 => T1, T2 => T2)
+           or else Covers (T1 => T2, T2 => T1)
+         then
+            T := Specific_Type (T1, T2);
+
+         elsif Is_User_Defined_Literal (First_Expr, T2) then
+            T := T2;
+
+         elsif Is_User_Defined_Literal (Next_Expr, T1) then
+            T := T1;
+
+         else
+            T := Possible_Type_For_Conditional_Expression (T1, T2);
+
+            if No (T) then
+               Wrong_Alt := Alt;
+               return;
+            end if;
+         end if;
+
+         if Present (Next (Alt)) then
+            Check_Next_Expression (T, Next (Alt));
+         else
+            Add_One_Interp (N, T, T);
+         end if;
+      end Check_Expression_Pair;
+
+      --  Local variables
+
+      Alt            : Node_Id;
+      Exp_Type       : Entity_Id;
+      Exp_Btype      : Entity_Id;
+      I              : Interp_Index;
+      It             : Interp;
+      Others_Present : Boolean;
 
    --  Start of processing for Analyze_Case_Expression
 
@@ -1611,16 +1705,23 @@ package body Sem_Ch4 is
       Exp_Type := Etype (Expr);
       Exp_Btype := Base_Type (Exp_Type);
 
-      Alt := First (Alternatives (N));
+      Set_Etype (N, Any_Type);
+
+      Alt := First_Alt;
       while Present (Alt) loop
          if Error_Posted (Expression (Alt)) then
             return;
          end if;
 
-         Analyze (Expression (Alt));
+         Analyze_Expression (Expression (Alt));
 
-         if No (FirstX) and then Etype (Expression (Alt)) /= Any_Type then
-            FirstX := Expression (Alt);
+         if Etype (Expression (Alt)) /= Any_Type then
+            if No (First_Expr) then
+               First_Expr := Expression (Alt);
+
+            elsif No (Second_Expr) then
+               Second_Expr := Expression (Alt);
+            end if;
          end if;
 
          Next (Alt);
@@ -1629,47 +1730,33 @@ package body Sem_Ch4 is
       --  Get our initial type from the first expression for which we got some
       --  useful type information from the expression.
 
-      if No (FirstX) then
+      if No (First_Expr) then
          return;
       end if;
 
-      if not Is_Overloaded (FirstX) then
-         Set_Etype (N, Etype (FirstX));
-
-      else
-         declare
-            I  : Interp_Index;
-            It : Interp;
+      --  Loop through the interpretations of the first expression and check
+      --  the other expressions if present.
 
-         begin
-            Set_Etype (N, Any_Type);
-
-            Get_First_Interp (FirstX, I, It);
-            while Present (It.Nam) loop
-
-               --  For each interpretation of the first expression, we only
-               --  add the interpretation if every other expression in the
-               --  case expression alternatives has a compatible type.
-
-               Alt := Next (First (Alternatives (N)));
-               while Present (Alt) loop
-                  exit when not Has_Compatible_Type (Expression (Alt), It.Typ);
-                  Next (Alt);
-               end loop;
+      if not Is_Overloaded (First_Expr) then
+         if Present (Second_Expr) then
+            Check_Next_Expression (Etype (First_Expr), First_Alt);
+         else
+            Set_Etype (N, Etype (First_Expr));
+         end if;
 
-               if No (Alt) then
-                  Add_One_Interp (N, It.Typ, It.Typ);
-               else
-                  Wrong_Alt := Alt;
-               end if;
+      else
+         Get_First_Interp (First_Expr, I, It);
+         while Present (It.Typ) loop
+            if Present (Second_Expr) then
+               Check_Next_Expression (It.Typ, First_Alt);
+            else
+               Add_One_Interp (N, It.Typ, It.Typ);
+            end if;
 
-               Get_Next_Interp (I, It);
-            end loop;
-         end;
+            Get_Next_Interp (I, It);
+         end loop;
       end if;
 
-      Exp_Btype := Base_Type (Exp_Type);
-
       --  The expression must be of a discrete type which must be determinable
       --  independently of the context in which the expression occurs, but
       --  using the fact that the expression must be of a discrete type.
@@ -1689,10 +1776,54 @@ package body Sem_Ch4 is
          return;
       end if;
 
+      --  If no possible interpretation has been found, the type of the wrong
+      --  alternative doesn't match any interpretation of the FIRST expression.
+
       if Etype (N) = Any_Type and then Present (Wrong_Alt) then
-         Error_Msg_N
-           ("type incompatible with that of previous alternatives",
-            Expression (Wrong_Alt));
+         Second_Expr := Expression (Wrong_Alt);
+
+         if Is_Overloaded (First_Expr) then
+            if Is_Overloaded (Second_Expr) then
+               Error_Msg_N
+                 ("no interpretation compatible with those of previous "
+                  & "alternative",
+                  Second_Expr);
+            else
+               Error_Msg_N
+                 ("type incompatible with interpretations of previous "
+                  & "alternative",
+                  Second_Expr);
+               Error_Msg_NE
+                 ("\this alternative has}!",
+                  Second_Expr,
+                  Etype (Second_Expr));
+            end if;
+
+         else
+            if Is_Overloaded (Second_Expr) then
+               Error_Msg_N
+                 ("no interpretation compatible with type of previous "
+                  & "alternative",
+                  Second_Expr);
+               Error_Msg_NE
+                 ("\previous alternative has}!",
+                  Second_Expr,
+                  Etype (First_Expr));
+            else
+               Error_Msg_N
+                 ("type incompatible with that of previous alternative",
+                  Second_Expr);
+               Error_Msg_NE
+                 ("\previous alternative has}!",
+                  Second_Expr,
+                  Etype (First_Expr));
+               Error_Msg_NE
+                 ("\this alternative has}!",
+                  Second_Expr,
+                  Etype (Second_Expr));
+            end if;
+         end if;
+
          return;
       end if;
 
@@ -2311,9 +2442,76 @@ package body Sem_Ch4 is
 
    procedure Analyze_If_Expression (N : Node_Id) is
       Condition : constant Node_Id := First (Expressions (N));
+
       Then_Expr : Node_Id;
       Else_Expr : Node_Id;
 
+      procedure Check_Else_Expression (T : Entity_Id);
+      --  Check one interpretation of the THEN expression with type T
+
+      procedure Check_Expression_Pair (T1, T2 : Entity_Id);
+      --  Check THEN expression with type T1 and ELSE expression with type T2
+
+      ---------------------------
+      -- Check_Else_Expression --
+      ---------------------------
+
+      procedure Check_Else_Expression (T : Entity_Id) is
+         I    : Interp_Index;
+         It   : Interp;
+
+      begin
+         --  Loop through the interpretations of the ELSE expression
+
+         if not Is_Overloaded (Else_Expr) then
+            Check_Expression_Pair (T, Etype (Else_Expr));
+
+         else
+            Get_First_Interp (Else_Expr, I, It);
+            while Present (It.Typ) loop
+               Check_Expression_Pair (T, It.Typ);
+               Get_Next_Interp (I, It);
+            end loop;
+         end if;
+      end Check_Else_Expression;
+
+      ---------------------------
+      -- Check_Expression_Pair --
+      ---------------------------
+
+      procedure Check_Expression_Pair (T1, T2 : Entity_Id) is
+         T : Entity_Id;
+
+      begin
+         if Covers (T1 => T1, T2 => T2)
+           or else Covers (T1 => T2, T2 => T1)
+         then
+            T := Specific_Type (T1, T2);
+
+         elsif Is_User_Defined_Literal (Then_Expr, T2) then
+            T := T2;
+
+         elsif Is_User_Defined_Literal (Else_Expr, T1) then
+            T := T1;
+
+         else
+            T := Possible_Type_For_Conditional_Expression (T1, T2);
+
+            if No (T) then
+               return;
+            end if;
+         end if;
+
+         Add_One_Interp (N, T, T);
+      end Check_Expression_Pair;
+
+      --  Local variables
+
+      I  : Interp_Index;
+      It : Interp;
+
+      --  Start of processing for Analyze_If_Expression
+
    begin
       --  Defend against error of missing expressions from previous error
 
@@ -2322,6 +2520,8 @@ package body Sem_Ch4 is
          return;
       end if;
 
+      Set_Etype (N, Any_Type);
+
       Then_Expr := Next (Condition);
 
       if No (Then_Expr) then
@@ -2340,8 +2540,8 @@ package body Sem_Ch4 is
       Analyze_Expression (Condition);
       Resolve (Condition, Any_Boolean);
 
-      --  Analyze THEN expression and (if present) ELSE expression. For those
-      --  we delay resolution in the normal manner, because of overloading etc.
+      --  Analyze the THEN expression and (if present) the ELSE expression. For
+      --  them we delay resolution in the normal manner because of overloading.
 
       Analyze_Expression (Then_Expr);
 
@@ -2349,49 +2549,65 @@ package body Sem_Ch4 is
          Analyze_Expression (Else_Expr);
       end if;
 
-      --  If then expression not overloaded, then that decides the type
+      --  Loop through the interpretations of the THEN expression and check the
+      --  ELSE expression if present.
 
       if not Is_Overloaded (Then_Expr) then
-         Set_Etype (N, Etype (Then_Expr));
-
-      --  Case where then expression is overloaded
+         if Present (Else_Expr) then
+            Check_Else_Expression (Etype (Then_Expr));
+         else
+            Set_Etype (N, Etype (Then_Expr));
+         end if;
 
       else
-         declare
-            I  : Interp_Index;
-            It : Interp;
-
-         begin
-            Set_Etype (N, Any_Type);
-
-            --  Loop through interpretations of Then_Expr
-
-            Get_First_Interp (Then_Expr, I, It);
-            while Present (It.Nam) loop
+         Get_First_Interp (Then_Expr, I, It);
+         while Present (It.Typ) loop
+            if Present (Else_Expr) then
+               Check_Else_Expression (It.Typ);
+            else
+               Add_One_Interp (N, It.Typ, It.Typ);
+            end if;
 
-               --  Add possible interpretation of Then_Expr if no Else_Expr, or
-               --  Else_Expr is present and has a compatible type.
+            Get_Next_Interp (I, It);
+         end loop;
+      end if;
 
-               if No (Else_Expr)
-                 or else Has_Compatible_Type (Else_Expr, It.Typ)
-               then
-                  Add_One_Interp (N, It.Typ, It.Typ);
-               end if;
+      --  If no possible interpretation has been found, the type of the
+      --  ELSE expression does not match any interpretation of the THEN
+      --  expression.
 
-               Get_Next_Interp (I, It);
-            end loop;
-
-            --  If no valid interpretation has been found, then the type of the
-            --  ELSE expression does not match any interpretation of the THEN
-            --  expression.
+      if Etype (N) = Any_Type then
+         if Is_Overloaded (Then_Expr) then
+            if Is_Overloaded (Else_Expr) then
+               Error_Msg_N
+                 ("no interpretation compatible with those of THEN expression",
+                  Else_Expr);
+            else
+               Error_Msg_N
+                 ("type of ELSE incompatible with interpretations of THEN "
+                  & "expression",
+                  Else_Expr);
+               Error_Msg_NE
+                 ("\ELSE expression has}!", Else_Expr, Etype (Else_Expr));
+            end if;
 
-            if Etype (N) = Any_Type then
+         else
+            if Is_Overloaded (Else_Expr) then
                Error_Msg_N
-                 ("type incompatible with that of THEN expression",
+                 ("no interpretation compatible with type of THEN expression",
                   Else_Expr);
-               return;
+               Error_Msg_NE
+                 ("\THEN expression has}!", Else_Expr, Etype (Then_Expr));
+            else
+               Error_Msg_N
+                 ("type of ELSE incompatible with that of THEN expression",
+                  Else_Expr);
+               Error_Msg_NE
+                 ("\THEN expression has}!", Else_Expr, Etype (Then_Expr));
+               Error_Msg_NE
+                 ("\ELSE expression has}!", Else_Expr, Etype (Else_Expr));
             end if;
-         end;
+         end if;
       end if;
    end Analyze_If_Expression;
 
@@ -7638,6 +7854,93 @@ package body Sem_Ch4 is
       return Etype (N) /= Any_Type;
    end Has_Possible_Literal_Aspects;
 
+   ----------------------------------------------
+   -- Possible_Type_For_Conditional_Expression --
+   ----------------------------------------------
+
+   function Possible_Type_For_Conditional_Expression
+     (T1, T2 : Entity_Id) return Entity_Id
+   is
+      function Is_Access_Protected_Subprogram_Attribute
+        (T : Entity_Id) return Boolean;
+      --  Return true if T is the type of an access-to-protected-subprogram
+      --  attribute.
+
+      function Is_Access_Subprogram_Attribute (T : Entity_Id) return Boolean;
+      --  Return true if T is the type of an access-to-subprogram attribute
+
+      ----------------------------------------------
+      -- Is_Access_Protected_Subprogram_Attribute --
+      ----------------------------------------------
+
+      function Is_Access_Protected_Subprogram_Attribute
+        (T : Entity_Id) return Boolean
+      is
+      begin
+         return Ekind (T) = E_Access_Protected_Subprogram_Type
+           and then Ekind (Designated_Type (T)) /= E_Subprogram_Type;
+      end Is_Access_Protected_Subprogram_Attribute;
+
+      ------------------------------------
+      -- Is_Access_Subprogram_Attribute --
+      ------------------------------------
+
+      function Is_Access_Subprogram_Attribute (T : Entity_Id) return Boolean is
+      begin
+         return Ekind (T) = E_Access_Subprogram_Type
+           and then Ekind (Designated_Type (T)) /= E_Subprogram_Type;
+      end Is_Access_Subprogram_Attribute;
+
+   --  Start of processing for Possible_Type_For_Conditional_Expression
+
+   begin
+      --  If both types are those of similar access attributes or allocators,
+      --  pick one of them, for example the first.
+
+      if Ekind (T1) in E_Access_Attribute_Type | E_Allocator_Type
+        and then Ekind (T2) in E_Access_Attribute_Type | E_Allocator_Type
+      then
+         return T1;
+
+      elsif Is_Access_Subprogram_Attribute (T1)
+        and then Is_Access_Subprogram_Attribute (T2)
+      then
+         return T1;
+
+      elsif Is_Access_Protected_Subprogram_Attribute (T1)
+        and then Is_Access_Protected_Subprogram_Attribute (T2)
+      then
+         return T1;
+
+      --  The other case to be considered is a pair of tagged types
+
+      elsif Is_Tagged_Type (T1) and then Is_Tagged_Type (T2) then
+         --  Covers performs the same checks when T1 or T2 are a CW type, so
+         --  we don't need to do them again here.
+
+         if not Is_Class_Wide_Type (T1) and then Is_Ancestor (T1, T2) then
+            return T1;
+
+         elsif not Is_Class_Wide_Type (T2) and then Is_Ancestor (T2, T1) then
+            return T2;
+
+         --  Neither type is an ancestor of the other, but they may have one in
+         --  common, so we pick the first type as above. We could perform here
+         --  the computation of the nearest common ancestors of T1 and T2, but
+         --  this would require a significant amount of work and the practical
+         --  benefit would very likely be negligible.
+
+         else
+            return T1;
+         end if;
+
+      --  Otherwise no type is possible
+
+      else
+         return Empty;
+      end if;
+   end Possible_Type_For_Conditional_Expression;
+
    --------------------------------
    -- Remove_Abstract_Operations --
    --------------------------------


diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -3361,13 +3361,13 @@ package body Sem_Type is
         and then Is_Class_Wide_Type (T2)
         and then Is_Interface (Etype (T2))
       then
-         return T1;
+         return B1;
 
       elsif Is_Class_Wide_Type (T2)
         and then Is_Class_Wide_Type (T1)
         and then Is_Interface (Etype (T1))
       then
-         return T2;
+         return B2;
 
       --  Ada 2005 (AI-251): T1 is a concrete type that implements the
       --  class-wide interface T2, return T1, and vice versa.
@@ -3378,7 +3378,7 @@ package body Sem_Type is
         and then Interface_Present_In_Ancestor (Typ   => T1,
                                                 Iface => Etype (T2))
       then
-         return T1;
+         return B1;
 
       elsif Is_Tagged_Type (T2)
         and then Is_Class_Wide_Type (T1)
@@ -3386,17 +3386,17 @@ package body Sem_Type is
         and then Interface_Present_In_Ancestor (Typ   => T2,
                                                 Iface => Etype (T1))
       then
-         return T2;
+         return B2;
 
       elsif Is_Class_Wide_Type (T1)
         and then Is_Ancestor (Root_Type (T1), T2)
       then
-         return T1;
+         return B1;
 
       elsif Is_Class_Wide_Type (T2)
         and then Is_Ancestor (Root_Type (T2), T1)
       then
-         return T2;
+         return B2;
 
       elsif Is_Access_Type (T1)
         and then Is_Access_Type (T2)


