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.

1 files changed, 83 insertions, 26 deletions

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