@@ -5098,10 +5098,20 @@ package body Exp_Ch4 is
else
if not Is_Copy_Type (Typ) then
- Alt_Expr :=
- Make_Attribute_Reference (Alt_Loc,
- Prefix => Relocate_Node (Alt_Expr),
- Attribute_Name => Name_Unrestricted_Access);
+ -- It's possible that a call to Apply_Length_Check in
+ -- Resolve_Case_Expression rewrote the dependent expression
+ -- into a N_Raise_Constraint_Error. If that's the case, we
+ -- don't create a reference to Unrestricted_Access, but we
+ -- update the type of the N_Raise_Constraint_Error node.
+
+ if Nkind (Alt_Expr) in N_Raise_Constraint_Error then
+ Set_Etype (Alt_Expr, Target_Typ);
+ else
+ Alt_Expr :=
+ Make_Attribute_Reference (Alt_Loc,
+ Prefix => Relocate_Node (Alt_Expr),
+ Attribute_Name => Name_Unrestricted_Access);
+ end if;
end if;
LHS := New_Occurrence_Of (Target, Loc);
@@ -7438,6 +7438,9 @@ package body Sem_Res is
if Is_Scalar_Type (Alt_Typ) and then Alt_Typ /= Typ then
Rewrite (Alt_Expr, Convert_To (Typ, Alt_Expr));
Analyze_And_Resolve (Alt_Expr, Typ);
+
+ elsif Is_Array_Type (Typ) then
+ Apply_Length_Check (Alt_Expr, Typ);
end if;
Next (Alt);
From: Ronan Desplanques <desplanques@adacore.com> This fixes an issue where length checks were not generated when the right-hand side of an assigment involved a case expression. gcc/ada/ * sem_res.adb (Resolve_Case_Expression): Add length check insertion. * exp_ch4.adb (Expand_N_Case_Expression): Add handling of nodes known to raise Constraint_Error. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch4.adb | 18 ++++++++++++++---- gcc/ada/sem_res.adb | 3 +++ 2 files changed, 17 insertions(+), 4 deletions(-)