[gcc r15-564] ada: Fix missing length checks with case expressions

[Marc Poulhi?s via Gcc-cvs]

https://gcc.gnu.org/g:5c9205a4d729e6fe9b8c897f4eb3ccd86dcf1835

commit r15-564-g5c9205a4d729e6fe9b8c897f4eb3ccd86dcf1835
Author: Ronan Desplanques <desplanq...@adacore.com>
Date:   Tue Feb 27 15:46:14 2024 +0100

    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:
---
 gcc/ada/exp_ch4.adb | 18 ++++++++++++++----
 gcc/ada/sem_res.adb |  3 +++
 2 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7a2003691ec5..448cd5c82b61 100644
--- 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 85795ba3a05f..d2eca7c54591 100644
--- 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);