diff options
| author | Ronan Desplanques <desplanques@adacore.com> | 2024-02-27 15:46:14 +0100 |
|---|---|---|
| committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-16 10:49:33 +0200 |
| commit | 5c9205a4d729e6fe9b8c897f4eb3ccd86dcf1835 (patch) | |
| tree | ebd1811060fb9533d96b537988efe17cdb3ffbf9 /gcc/ada | |
| parent | ea648848eac40e07df0b0e1f5762b5d3f3f738c6 (diff) | |
| download | gcc-5c9205a4d729e6fe9b8c897f4eb3ccd86dcf1835.zip gcc-5c9205a4d729e6fe9b8c897f4eb3ccd86dcf1835.tar.gz gcc-5c9205a4d729e6fe9b8c897f4eb3ccd86dcf1835.tar.bz2 | |
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.
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 18 | ||||
| -rw-r--r-- | 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 7a20036..448cd5c 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 85795ba..d2eca7c 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); |