diff options
author | Steve Baird <baird@adacore.com> | 2024-04-05 12:35:08 -0700 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-21 09:26:49 +0200 |
commit | 2ccf77d982d41dda5d352e99d67f901d1cfb7668 (patch) | |
tree | 8bb5e9909383984241d0345b17b0e45684353f42 | |
parent | 8cadfeb5f6d7d15cb3d008b11105a2e67b46dbe9 (diff) | |
download | gcc-2ccf77d982d41dda5d352e99d67f901d1cfb7668.zip gcc-2ccf77d982d41dda5d352e99d67f901d1cfb7668.tar.gz gcc-2ccf77d982d41dda5d352e99d67f901d1cfb7668.tar.bz2 |
ada: Missing constraint check for initial value of object with address clause
In some cases where an object is declared with an initial value that is
an aggregate and also with a specified Address (either via an
aspect_specification or via an attribute_definition_clause), the
check that the initial value satisfies the constraints of the object's
subtype was incorrectly omitted.
gcc/ada/
* exp_util.adb (Remove_Side_Effects): Make_Reference assumes that
the referenced object satisfies the constraints of the designated
subtype of the access type. Ensure that this assumption holds by
introducing a qualified expression if needed (and then ensuring
that checking associated with evaluation of the qualified
expression is not suppressed).
-rw-r--r-- | gcc/ada/exp_util.adb | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b71f773..654ea7d 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -12772,6 +12772,35 @@ package body Exp_Util is -- since we know it cannot be null and we don't want a check. else + -- Make_Reference assumes that the referenced + -- object satisfies the constraints of the designated + -- subtype of the access type. Ensure that this assumption + -- holds by introducing a qualified expression if needed. + + if not Analyzed (Exp) + and then Nkind (Exp) = N_Aggregate + and then (Is_Array_Type (Exp_Type) + or else Has_Discriminants (Exp_Type)) + and then Is_Constrained (Exp_Type) + then + -- Do not suppress checks associated with the qualified + -- expression we are about to introduce (unless those + -- checks were already suppressed when Remove_Side_Effects + -- was called). + + if Is_Array_Type (Exp_Type) then + Scope_Suppress.Suppress (Length_Check) + := Svg_Suppress.Suppress (Length_Check); + else + Scope_Suppress.Suppress (Discriminant_Check) + := Svg_Suppress.Suppress (Discriminant_Check); + end if; + + E := Make_Qualified_Expression (Loc, + Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), + Expression => E); + end if; + New_Exp := Make_Reference (Loc, E); Set_Is_Known_Non_Null (Def_Id); end if; |