ada: Fix missing length checks with case expressions

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.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7a2003691ec5a0d27a78079be85dd18b397ec2e0..448cd5c82b619549b7c9cd91e0b0271590de8f21 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -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);

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 85795ba3a05f0f84a1464b032f1a0859bb6c7ee2..d2eca7c54591204fbe5f8eee5bed0225f52e6b81 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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);