From: Eric Botcazou Date: Thu, 7 Jul 2022 22:01:15 +0000 (+0200) Subject: [Ada] Fix crash on declaration of overaligned array with constraints X-Git-Tag: basepoints/gcc-14~4837 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7f64e37c1f6d5c0e7db588171cfff194cd78d490;p=thirdparty%2Fgcc.git [Ada] Fix crash on declaration of overaligned array with constraints The semantic analyzer was setting the Is_Constr_Subt_For_UN_Aliased flag on the actual subtype of the object, which is incorrect because the nominal subtype is constrained. This also adjusts a recent related change. gcc/ada/ * exp_util.adb (Expand_Subtype_From_Expr): Check for the presence of the Is_Constr_Subt_For_U_Nominal flag instead of the absence of the Is_Constr_Subt_For_UN_Aliased flag on the subtype of the expression of an object declaration before reusing this subtype. * sem_ch3.adb (Analyze_Object_Declaration): Do not incorrectly set the Is_Constr_Subt_For_UN_Aliased flag on the actual subtype of an array with definite nominal subtype. Remove useless test. --- diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 3286bf6c8963..a8636bbe55da 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -5732,14 +5732,17 @@ package body Exp_Util is then if Is_Itype (Exp_Typ) - -- If Exp_Typ was created for a previous declaration whose nominal - -- subtype is unconstrained, and that declaration is aliased, - -- we need to generate a new subtype, because otherwise the - -- Is_Constr_Subt_For_U_Nominal flag will be set on the wrong - -- subtype, causing failure to detect non-statically-matching - -- subtypes on 'Access of the previously-declared object. - - and then not Is_Constr_Subt_For_UN_Aliased (Exp_Typ) + -- When this is for an object declaration, the caller may want to + -- set Is_Constr_Subt_For_U_Nominal on the subtype, so we must make + -- sure that either the subtype has been built for the expression, + -- typically for an aggregate, or the flag is already set on it; + -- otherwise it could end up being set on the nominal constrained + -- subtype of an object and thus later cause the failure to detect + -- non-statically-matching subtypes on 'Access of this object. + + and then (Nkind (N) /= N_Object_Declaration + or else Nkind (Exp) = N_Aggregate + or else Is_Constr_Subt_For_U_Nominal (Exp_Typ)) then -- Within an initialization procedure, a selected component -- denotes a component of the enclosing record, and it appears as diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 790d1d1b2beb..223849cc500c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4770,20 +4770,13 @@ package body Sem_Ch3 is if not Is_Entity_Name (Object_Definition (N)) then Act_T := Etype (E); Check_Compile_Time_Size (Act_T); - - if Aliased_Present (N) then - Set_Is_Constr_Subt_For_UN_Aliased (Act_T); - end if; end if; -- When the given object definition and the aggregate are specified -- independently, and their lengths might differ do a length check. -- This cannot happen if the aggregate is of the form (others =>...) - if not Is_Constrained (T) then - null; - - elsif Nkind (E) = N_Raise_Constraint_Error then + if Nkind (E) = N_Raise_Constraint_Error then -- Aggregate is statically illegal. Place back in declaration