diff options
author | Ed Schonberg <schonberg@adacore.com> | 2021-01-14 17:54:05 -0500 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-05-06 03:51:20 -0400 |
commit | c2f94a898f16d790e21533a6e0d345c23dd379a0 (patch) | |
tree | b8670e74409b7cff80753b552d4c1ecb292f6769 | |
parent | afab03da75f6b5e11087738d71aeb8c3efa40f1c (diff) | |
download | gcc-c2f94a898f16d790e21533a6e0d345c23dd379a0.zip gcc-c2f94a898f16d790e21533a6e0d345c23dd379a0.tar.gz gcc-c2f94a898f16d790e21533a6e0d345c23dd379a0.tar.bz2 |
[Ada] Crash on if_expression used as index of discriminant-dependent array
gcc/ada/
* sem_res.adb (Resolve_If_Expression): If the context of the
expression is an indexed_component, resolve the expression and
its dependent_expressions with the base type of the index, to
ensure that an index check is generated when resolving the
enclosing indexxed_component, and avoid an improper use of
discriminants out of scope, when the index type is
discriminant-dependent.
-rw-r--r-- | gcc/ada/sem_res.adb | 28 |
1 files changed, 22 insertions, 6 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 77af6ce..88d294e 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9095,6 +9095,16 @@ 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 -- ----------------- @@ -9118,10 +9128,10 @@ package body Sem_Res is else Rewrite (Expr, Make_Qualified_Expression (Loc, - Subtype_Mark => New_Occurrence_Of (Typ, Loc), + Subtype_Mark => New_Occurrence_Of (Result_Type, Loc), Expression => Relocate_Node (Expr))); - Analyze_And_Resolve (Expr, Typ); + Analyze_And_Resolve (Expr, Result_Type); end if; end Apply_Check; @@ -9140,6 +9150,12 @@ package body Sem_Res is return; end if; + if Nkind (Parent (N)) = N_Indexed_Component + or else Nkind (Parent (Parent (N))) = N_Indexed_Component + then + Result_Type := Base_Type (Typ); + end if; + Then_Expr := Next (Condition); if No (Then_Expr) then @@ -9149,7 +9165,7 @@ package body Sem_Res is Else_Expr := Next (Then_Expr); Resolve (Condition, Any_Boolean); - Resolve (Then_Expr, Typ); + Resolve (Then_Expr, Result_Type); Apply_Check (Then_Expr); -- If ELSE expression present, just resolve using the determined type @@ -9163,7 +9179,7 @@ package body Sem_Res is Resolve (Else_Expr, Any_Real); else - Resolve (Else_Expr, Typ); + Resolve (Else_Expr, Result_Type); end if; Apply_Check (Else_Expr); @@ -9187,7 +9203,7 @@ package body Sem_Res is elsif Root_Type (Typ) = Standard_Boolean then Else_Expr := Convert_To (Typ, New_Occurrence_Of (Standard_True, Sloc (N))); - Analyze_And_Resolve (Else_Expr, Typ); + Analyze_And_Resolve (Else_Expr, Result_Type); Append_To (Expressions (N), Else_Expr); else @@ -9195,7 +9211,7 @@ package body Sem_Res is Append_To (Expressions (N), Error); end if; - Set_Etype (N, Typ); + Set_Etype (N, Result_Type); if not Error_Posted (N) then Eval_If_Expression (N); |