https://gcc.gnu.org/g:f6eb93dec5d355933cd0478db6bf43dfdb3aad06
commit r16-4692-gf6eb93dec5d355933cd0478db6bf43dfdb3aad06 Author: Eric Botcazou <[email protected]> Date: Wed Oct 1 12:28:59 2025 +0200 ada: Fix miscompilation at -O2 due to aliasing issue caused by -gnatVa The problem is that the expanded code generated by -gnatVa (-gnatVc to be precise) violates strict aliasing rules, because it contains a 'Reference to an elementary component that is nonaliased ('Reference is equivalent to a pointer for code generation purposes and the "aliased" keyword is trusted for components whose type is elementary by code generators). Remove_Side_Effects already knows that it must make a copy for elementary types instead of taking 'Reference, but it is fooled by the private type of the expression. The fix is to still use the Etype to build new nodes, but to use its Underlying_Type to select the strategy to do so. gcc/ada/ChangeLog: * exp_util.adb (Remove_Side_Effects): Use separately the Etype of the expression to build new nodes and its Underlying_Type to drive part of the processing. Diff: --- gcc/ada/exp_util.adb | 81 ++++++++++++++++++++++++++++------------------------ 1 file changed, 43 insertions(+), 38 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 30b2461c4af6..4d88626e0d24 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -12613,8 +12613,12 @@ package body Exp_Util is -- Local variables Loc : constant Source_Ptr := Sloc (Exp); - Exp_Type : constant Entity_Id := Etype (Exp); Svg_Suppress : constant Suppress_Record := Scope_Suppress; + Typ : constant Entity_Id := Etype (Exp); + Und_Typ : constant Entity_Id := + (if Present (Typ) then Underlying_Type (Typ) else Typ); + -- The underlying type that drives part of the processing + Def_Id : Entity_Id; E : Node_Id; New_Exp : Node_Id; @@ -12640,8 +12644,9 @@ package body Exp_Util is -- (this happens because routines Duplicate_Subexpr_XX implicitly invoke -- Remove_Side_Effects). - elsif No (Exp_Type) - or else Ekind (Exp_Type) = E_Access_Attribute_Type + elsif No (Typ) + or else No (Und_Typ) + or else Ekind (Und_Typ) = E_Access_Attribute_Type then return; @@ -12690,12 +12695,12 @@ package body Exp_Util is -- anyway, see below). Also do it if we have a volatile reference and -- Name_Req is not set (see comments for Side_Effect_Free). - elsif (Is_Elementary_Type (Exp_Type) - or else (Is_Record_Type (Exp_Type) - and then Known_Static_RM_Size (Exp_Type) - and then RM_Size (Exp_Type) <= System_Max_Integer_Size - and then not Has_Discriminants (Exp_Type) - and then not Is_By_Reference_Type (Exp_Type))) + elsif (Is_Elementary_Type (Und_Typ) + or else (Is_Record_Type (Und_Typ) + and then Known_Static_RM_Size (Und_Typ) + and then RM_Size (Und_Typ) <= System_Max_Integer_Size + and then not Has_Discriminants (Und_Typ) + and then not Is_By_Reference_Type (Und_Typ))) and then (Variable_Ref or else (not Is_Name_Reference (Exp) and then Nkind (Exp) /= N_Type_Conversion) @@ -12703,7 +12708,7 @@ package body Exp_Util is and then Is_Volatile_Reference (Exp))) then Def_Id := Build_Temporary (Loc, 'R', Exp); - Set_Etype (Def_Id, Exp_Type); + Set_Etype (Def_Id, Typ); Res := New_Occurrence_Of (Def_Id, Loc); -- If the expression is a packed reference, it must be reanalyzed and @@ -12719,7 +12724,7 @@ package body Exp_Util is end if; -- Generate: - -- Rnn : Exp_Type renames Expr; + -- Rnn : Typ renames Expr; -- In GNATprove mode, we prefer to use renamings for intermediate -- variables to definition of constants, due to the implicit move @@ -12730,22 +12735,22 @@ package body Exp_Util is if Renaming_Req or else (GNATprove_Mode and then Is_Object_Reference (Exp) - and then not Is_Scalar_Type (Exp_Type)) + and then not Is_Scalar_Type (Und_Typ)) then E := Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Def_Id, - Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), + Subtype_Mark => New_Occurrence_Of (Typ, Loc), Name => Relocate_Node (Exp)); -- Generate: - -- Rnn : constant Exp_Type := Expr; + -- Rnn : constant Typ := Expr; else E := Make_Object_Declaration (Loc, Defining_Identifier => Def_Id, - Object_Definition => New_Occurrence_Of (Exp_Type, Loc), + Object_Definition => New_Occurrence_Of (Typ, Loc), Constant_Present => True, Expression => Relocate_Node (Exp)); @@ -12801,7 +12806,7 @@ package body Exp_Util is elsif Nkind (Exp) = N_Unchecked_Type_Conversion and then not Safe_Unchecked_Type_Conversion (Exp) then - if CW_Or_Needs_Finalization (Exp_Type) then + if CW_Or_Needs_Finalization (Und_Typ) then -- Use a renaming to capture the expression, rather than create -- a controlled temporary. @@ -12812,18 +12817,18 @@ package body Exp_Util is Insert_Action (Exp, Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Def_Id, - Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), + Subtype_Mark => New_Occurrence_Of (Typ, Loc), Name => Relocate_Node (Exp))); else Def_Id := Build_Temporary (Loc, 'R', Exp); - Set_Etype (Def_Id, Exp_Type); + Set_Etype (Def_Id, Typ); Res := New_Occurrence_Of (Def_Id, Loc); E := Make_Object_Declaration (Loc, Defining_Identifier => Def_Id, - Object_Definition => New_Occurrence_Of (Exp_Type, Loc), + Object_Definition => New_Occurrence_Of (Typ, Loc), Constant_Present => not Is_Variable (Exp), Expression => Relocate_Node (Exp)); @@ -12853,7 +12858,7 @@ package body Exp_Util is -- type and we do not have Name_Req set true (see comments for -- Side_Effect_Free). - and then (Name_Req or else not Treat_As_Volatile (Exp_Type))) + and then (Name_Req or else not Treat_As_Volatile (Und_Typ))) then Def_Id := Build_Temporary (Loc, 'R', Exp); Res := New_Occurrence_Of (Def_Id, Loc); @@ -12861,7 +12866,7 @@ package body Exp_Util is Insert_Action (Exp, Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Def_Id, - Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), + Subtype_Mark => New_Occurrence_Of (Typ, Loc), Name => Relocate_Node (Exp))); -- Avoid generating a variable-sized temporary, by generating the @@ -12871,7 +12876,7 @@ package body Exp_Util is elsif Nkind (Exp) = N_Selected_Component and then Nkind (Prefix (Exp)) = N_Function_Call - and then Is_Array_Type (Exp_Type) + and then Is_Array_Type (Und_Typ) then Remove_Side_Effects (Prefix (Exp), Name_Req, Variable_Ref); goto Leave; @@ -12890,9 +12895,9 @@ package body Exp_Util is -- to the object in the latter case. if Nkind (Exp) = N_Function_Call - and then (Is_Build_In_Place_Result_Type (Exp_Type) + and then (Is_Build_In_Place_Result_Type (Und_Typ) or else - Is_Constr_Array_Subt_Of_Unc_With_Controlled (Exp_Type)) + Is_Constr_Array_Subt_Of_Unc_With_Controlled (Und_Typ)) and then Nkind (Parent (Exp)) /= N_Object_Declaration and then not Is_Expression_Of_Func_Return (Exp) then @@ -12904,11 +12909,11 @@ package body Exp_Util is Decl := Make_Object_Declaration (Loc, Defining_Identifier => Obj, - Object_Definition => New_Occurrence_Of (Exp_Type, Loc), + Object_Definition => New_Occurrence_Of (Typ, Loc), Expression => Relocate_Node (Exp)); Insert_Action (Exp, Decl); - Set_Etype (Obj, Exp_Type); + Set_Etype (Obj, Typ); Rewrite (Exp, New_Occurrence_Of (Obj, Loc)); goto Leave; end; @@ -12924,7 +12929,7 @@ package body Exp_Util is if GNATprove_Mode then Res := New_Occurrence_Of (Def_Id, Loc); - Ref_Type := Exp_Type; + Ref_Type := Typ; -- Regular expansion utilizing an access type and 'reference @@ -12934,7 +12939,7 @@ package body Exp_Util is Prefix => New_Occurrence_Of (Def_Id, Loc)); -- Generate: - -- type Ann is access all <Exp_Type>; + -- type Ann is access all Typ; Ref_Type := Make_Temporary (Loc, 'A'); @@ -12944,8 +12949,7 @@ package body Exp_Util is Type_Definition => Make_Access_To_Object_Definition (Loc, All_Present => True, - Subtype_Indication => - New_Occurrence_Of (Exp_Type, Loc))); + Subtype_Indication => New_Occurrence_Of (Typ, Loc))); Insert_Action (Exp, Ptr_Typ_Decl); end if; @@ -12974,16 +12978,16 @@ package body Exp_Util is 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) + and then (Is_Array_Type (Und_Typ) + or else Has_Discriminants (Und_Typ)) + and then Is_Constrained (Und_Typ) 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 + if Is_Array_Type (Und_Typ) then Scope_Suppress.Suppress (Length_Check) := Svg_Suppress.Suppress (Length_Check); else @@ -12991,9 +12995,10 @@ package body Exp_Util is Svg_Suppress.Suppress (Discriminant_Check); end if; - E := Make_Qualified_Expression (Loc, - Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), - Expression => E); + E := + Make_Qualified_Expression (Loc, + Subtype_Mark => New_Occurrence_Of (Typ, Loc), + Expression => E); end if; New_Exp := Make_Reference (Loc, E); @@ -13041,7 +13046,7 @@ package body Exp_Util is -- Finally rewrite the original expression and we are done Rewrite (Exp, Res); - Analyze_And_Resolve (Exp, Exp_Type); + Analyze_And_Resolve (Exp, Typ); <<Leave>> Scope_Suppress := Svg_Suppress;
