aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Baird <baird@adacore.com>2024-04-05 12:35:08 -0700
committerMarc Poulhiès <poulhies@adacore.com>2024-05-21 09:26:49 +0200
commit2ccf77d982d41dda5d352e99d67f901d1cfb7668 (patch)
tree8bb5e9909383984241d0345b17b0e45684353f42
parent8cadfeb5f6d7d15cb3d008b11105a2e67b46dbe9 (diff)
downloadgcc-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.adb29
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;