ada: Implement RM 4.5.7(10/3) name resolution rule

This rule deals with the specific case of a conditional expression that is
the operand of a type conversion and effectively distributes the conversion
to the dependent expressions with the help of the dynamic semantics.

gcc/ada/

	* sem_ch4.adb (Analyze_Case_Expression): Compute the
	interpretations of the expression only at the end of the analysis,
	but skip doing it if it is the operand of a type conversion.
	(Analyze_If_Expression): Likewise.
	* sem_res.adb (Resolve): Deal specially with conditional
	expression that is the operand of a type conversion.
	(Resolve_Dependent_Expression): New procedure.
	(Resolve_Case_Expression): Call Resolve_Dependent_Expression.
	(Resolve_If_Expression): Likewise.
	(Resolve_If_Expression.Apply_Check): Take result type as
	parameter.
	(Resolve_Type_Conversion): Do not warn about a redundant
	conversion when the operand is a conditional expression.

2 files changed, 156 insertions, 82 deletions

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 0c02fd8..23040d7 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -1740,6 +1740,70 @@ package body Sem_Ch4 is
          return;
       end if;
 
+      --  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.
+      --  Moreover, the type this expression must not be a character literal
+      --  (which is always ambiguous).
+
+      --  If error already reported by Resolve, nothing more to do
+
+      if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then
+         return;
+
+      --  Special case message for character literal
+
+      elsif Exp_Btype = Any_Character then
+         Error_Msg_N
+           ("character literal as case expression is ambiguous", Expr);
+         return;
+      end if;
+
+      --  If the case expression is a formal object of mode in out, then
+      --  treat it as having a nonstatic subtype by forcing use of the base
+      --  type (which has to get passed to Check_Case_Choices below). Also
+      --  use base type when the case expression is parenthesized.
+
+      if Paren_Count (Expr) > 0
+        or else (Is_Entity_Name (Expr)
+                  and then Ekind (Entity (Expr)) = E_Generic_In_Out_Parameter)
+      then
+         Exp_Type := Exp_Btype;
+      end if;
+
+      --  The case expression alternatives cover the range of a static subtype
+      --  subject to aspect Static_Predicate. Do not check the choices when the
+      --  case expression has not been fully analyzed yet because this may lead
+      --  to bogus errors.
+
+      if Is_OK_Static_Subtype (Exp_Type)
+        and then Has_Static_Predicate_Aspect (Exp_Type)
+        and then In_Spec_Expression
+      then
+         null;
+
+      --  Call Analyze_Choices and Check_Choices to do the rest of the work
+
+      else
+         Analyze_Choices (Alternatives (N), Exp_Type);
+         Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
+
+         if Exp_Type = Universal_Integer and then not Others_Present then
+            Error_Msg_N
+              ("case on universal integer requires OTHERS choice", Expr);
+            return;
+         end if;
+      end if;
+
+      --  RM 4.5.7(10/3): If the case_expression is the operand of a type
+      --  conversion, the type of the case_expression is the target type
+      --  of the conversion.
+
+      if Nkind (Parent (N)) = N_Type_Conversion then
+         Set_Etype (N, Etype (Parent (N)));
+         return;
+      end if;
+
       --  Loop through the interpretations of the first expression and check
       --  the other expressions if present.
 
@@ -1763,25 +1827,6 @@ package body Sem_Ch4 is
          end loop;
       end if;
 
-      --  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.
-      --  Moreover, the type this expression must not be a character literal
-      --  (which is always ambiguous).
-
-      --  If error already reported by Resolve, nothing more to do
-
-      if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then
-         return;
-
-      --  Special casee message for character literal
-
-      elsif Exp_Btype = Any_Character then
-         Error_Msg_N
-           ("character literal as case expression is ambiguous", Expr);
-         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.
 
@@ -1829,43 +1874,6 @@ package body Sem_Ch4 is
                   Etype (Second_Expr));
             end if;
          end if;
-
-         return;
-      end if;
-
-      --  If the case expression is a formal object of mode in out, then
-      --  treat it as having a nonstatic subtype by forcing use of the base
-      --  type (which has to get passed to Check_Case_Choices below). Also
-      --  use base type when the case expression is parenthesized.
-
-      if Paren_Count (Expr) > 0
-        or else (Is_Entity_Name (Expr)
-                  and then Ekind (Entity (Expr)) = E_Generic_In_Out_Parameter)
-      then
-         Exp_Type := Exp_Btype;
-      end if;
-
-      --  The case expression alternatives cover the range of a static subtype
-      --  subject to aspect Static_Predicate. Do not check the choices when the
-      --  case expression has not been fully analyzed yet because this may lead
-      --  to bogus errors.
-
-      if Is_OK_Static_Subtype (Exp_Type)
-        and then Has_Static_Predicate_Aspect (Exp_Type)
-        and then In_Spec_Expression
-      then
-         null;
-
-      --  Call Analyze_Choices and Check_Choices to do the rest of the work
-
-      else
-         Analyze_Choices (Alternatives (N), Exp_Type);
-         Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
-
-         if Exp_Type = Universal_Integer and then not Others_Present then
-            Error_Msg_N
-              ("case on universal integer requires OTHERS choice", Expr);
-         end if;
       end if;
    end Analyze_Case_Expression;
 
@@ -2555,6 +2563,15 @@ package body Sem_Ch4 is
          Analyze_Expression (Else_Expr);
       end if;
 
+      --  RM 4.5.7(10/3): If the if_expression is the operand of a type
+      --  conversion, the type of the if_expression is the target type
+      --  of the conversion.
+
+      if Nkind (Parent (N)) = N_Type_Conversion then
+         Set_Etype (N, Etype (Parent (N)));
+         return;
+      end if;
+
       --  Loop through the interpretations of the THEN expression and check the
       --  ELSE expression if present.
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e5b3612..c8652c9 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -171,6 +171,13 @@ package body Sem_Res is
    --  of the task, it must be replaced with a reference to the discriminant
    --  of the task being called.
 
+   procedure Resolve_Dependent_Expression
+     (N    : Node_Id;
+      Expr : Node_Id;
+      Typ  : Entity_Id);
+   --  Internal procedure to resolve the dependent expression Expr of the
+   --  conditional expression N with type Typ.
+
    procedure Resolve_Op_Concat_Arg
      (N       : Node_Id;
       Arg     : Node_Id;
@@ -291,12 +298,6 @@ package body Sem_Res is
    --  Called after N has been resolved and evaluated, but before range checks
    --  have been applied. This rewrites the conversion into a simpler form.
 
-   function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-   --  A universal_fixed expression in an universal context is unambiguous if
-   --  there is only one applicable fixed point type. Determining whether there
-   --  is only one requires a search over all visible entities, and happens
-   --  only in very pathological cases (see 6115-006).
-
    function Try_User_Defined_Literal
      (N   : Node_Id;
       Typ : Entity_Id) return Boolean;
@@ -306,6 +307,12 @@ package body Sem_Res is
    --  If such aspect exists, replace literal with a call to the
    --  corresponding function and return True, return false otherwise.
 
+   function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
+   --  A universal_fixed expression in an universal context is unambiguous if
+   --  there is only one applicable fixed point type. Determining whether there
+   --  is only one requires a search over all visible entities, and happens
+   --  only in very pathological cases (see 6115-006).
+
    -------------------------
    -- Ambiguous_Character --
    -------------------------
@@ -2461,6 +2468,15 @@ package body Sem_Res is
          Found := True;
          Expr_Type := Etype (Expression (N));
 
+      --  The resolution of a conditional expression that is the operand of a
+      --  type conversion is determined by the conversion (RM 4.5.7(10/3)).
+
+      elsif Nkind (N) in N_Case_Expression | N_If_Expression
+        and then Nkind (Parent (N)) = N_Type_Conversion
+      then
+         Found := True;
+         Expr_Type := Etype (Parent (N));
+
       --  If not overloaded, then we know the type, and all that needs doing
       --  is to check that this type is compatible with the context.
 
@@ -7390,7 +7406,8 @@ package body Sem_Res is
             return;
          end if;
 
-         Resolve (Alt_Expr, Typ);
+         Resolve_Dependent_Expression (N, Alt_Expr, Typ);
+
          Check_Unset_Reference (Alt_Expr);
          Alt_Typ := Etype (Alt_Expr);
 
@@ -7671,6 +7688,34 @@ package body Sem_Res is
       Check_Unset_Reference (Expr);
    end Resolve_Declare_Expression;
 
+   -----------------------------------
+   --  Resolve_Dependent_Expression --
+   -----------------------------------
+
+   procedure Resolve_Dependent_Expression
+     (N    : Node_Id;
+      Expr : Node_Id;
+      Typ  : Entity_Id)
+   is
+   begin
+      --  RM 4.5.7(8/3) says that the expected type of dependent expressions is
+      --  that of the conditional expression but RM 4.5.7(10/3) forces the type
+      --  of the conditional expression without changing the expected type (the
+      --  expected type of the operand of a type conversion is any type), so we
+      --  may have a gap between these two types that is bridged by the dynamic
+      --  semantics specified by RM 4.5.7(20/3) with the associated legality
+      --  rule RM 4.5.7(16/3) that will be automatically enforced.
+
+      if Nkind (Parent (N)) = N_Type_Conversion
+        and then Nkind (Expr) /= N_Raise_Expression
+      then
+         Convert_To_And_Rewrite (Typ, Expr);
+         Analyze_And_Resolve (Expr);
+      else
+         Resolve (Expr, Typ);
+      end if;
+   end Resolve_Dependent_Expression;
+
    -----------------------------------------
    -- Resolve_Discrete_Subtype_Indication --
    -----------------------------------------
@@ -9307,7 +9352,9 @@ package body Sem_Res is
    ---------------------------
 
    procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id) is
-      procedure Apply_Check (Expr : Node_Id);
+      Condition : constant Node_Id := First (Expressions (N));
+
+      procedure Apply_Check (Expr : Node_Id; Result_Type : Entity_Id);
       --  When a dependent expression is of a subtype different from
       --  the context subtype, then insert a qualification to ensure
       --  the generation of a constraint check. This was previously
@@ -9315,21 +9362,11 @@ package body Sem_Res is
       --  that the context in general allows sliding, while a qualified
       --  expression forces equality of bounds.
 
-      Result_Type  : Entity_Id := Typ;
-      --  So in most cases the type of the If_Expression and of its
-      --  dependent expressions is that of the context. However, if
-      --  the expression is the index of an Indexed_Component, we must
-      --  ensure that a proper index check is applied, rather than a
-      --  range check on the index type (which might be discriminant
-      --  dependent). In this case we resolve with the base type of the
-      --  index type, and the index check is generated in the resolution
-      --  of the indexed_component above.
-
       -----------------
       -- Apply_Check --
       -----------------
 
-      procedure Apply_Check (Expr : Node_Id) is
+      procedure Apply_Check (Expr : Node_Id; Result_Type : Entity_Id) is
          Expr_Typ : constant Entity_Id  := Etype (Expr);
          Loc      : constant Source_Ptr := Sloc (Expr);
 
@@ -9357,10 +9394,19 @@ package body Sem_Res is
 
       --  Local variables
 
-      Condition : constant Node_Id := First (Expressions (N));
       Else_Expr : Node_Id;
       Then_Expr : Node_Id;
 
+      Result_Type : Entity_Id;
+      --  So in most cases the type of the if_expression and of its
+      --  dependent expressions is that of the context. However, if
+      --  the expression is the index of an Indexed_Component, we must
+      --  ensure that a proper index check is applied, rather than a
+      --  range check on the index type (which might be discriminant
+      --  dependent). In this case we resolve with the base type of the
+      --  index type, and the index check is generated in the resolution
+      --  of the indexed_component above.
+
    --  Start of processing for Resolve_If_Expression
 
    begin
@@ -9375,6 +9421,9 @@ package body Sem_Res is
                     or else Nkind (Parent (Parent (N))) = N_Indexed_Component)
       then
          Result_Type := Base_Type (Typ);
+
+      else
+         Result_Type := Typ;
       end if;
 
       Then_Expr := Next (Condition);
@@ -9383,21 +9432,23 @@ package body Sem_Res is
          return;
       end if;
 
-      Else_Expr := Next (Then_Expr);
-
       Resolve (Condition, Any_Boolean);
-      Resolve (Then_Expr, Result_Type);
       Check_Unset_Reference (Condition);
+
+      Resolve_Dependent_Expression (N, Then_Expr, Result_Type);
+
       Check_Unset_Reference (Then_Expr);
+      Apply_Check (Then_Expr, Result_Type);
 
-      Apply_Check (Then_Expr);
+      Else_Expr := Next (Then_Expr);
 
       --  If ELSE expression present, just resolve using the determined type
 
       if Present (Else_Expr) then
-         Resolve (Else_Expr, Result_Type);
+         Resolve_Dependent_Expression (N, Else_Expr, Result_Type);
+
          Check_Unset_Reference (Else_Expr);
-         Apply_Check (Else_Expr);
+         Apply_Check (Else_Expr, Result_Type);
 
          --  Apply RM 4.5.7 (17/3): whether the expression is statically or
          --  dynamically tagged must be known statically.
@@ -12158,6 +12209,12 @@ package body Sem_Res is
             then
                null;
 
+            --  Never give a warning if the operand is a conditional expression
+            --  because RM 4.5.7(10/3) forces its type to be the target type.
+
+            elsif Nkind (Orig_N) in N_Case_Expression | N_If_Expression then
+               null;
+
             --  Finally, if this type conversion occurs in a context requiring
             --  a prefix, and the expression is a qualified expression then the
             --  type conversion is not redundant, since a qualified expression