From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 6F6383857801; Fri, 1 Oct 2021 06:14:46 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6F6383857801 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-4008] [Ada] Spurious range checks on aggregate with non-static bounds X-Act-Checkin: gcc X-Git-Author: Ed Schonberg X-Git-Refname: refs/heads/master X-Git-Oldrev: 3e20570d9076d8792db2c22eb12261c47e161ab0 X-Git-Newrev: 6732c4035d54dbc543e067aa1886c88939b0fed5 Message-Id: <20211001061446.6F6383857801@sourceware.org> Date: Fri, 1 Oct 2021 06:14:46 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 01 Oct 2021 06:14:46 -0000 https://gcc.gnu.org/g:6732c4035d54dbc543e067aa1886c88939b0fed5 commit r12-4008-g6732c4035d54dbc543e067aa1886c88939b0fed5 Author: Ed Schonberg Date: Sun Aug 8 10:34:38 2021 -0400 [Ada] Spurious range checks on aggregate with non-static bounds gcc/ada/ * exp_aggr.adb (Must_Slide): If the aggregate only contains an others_clause no sliding id involved. Otherwise sliding is required if any bound of the aggregate or the context subtype is non-static. Diff: --- gcc/ada/exp_aggr.adb | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index a16ee9e850c..461e4faac20 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -124,7 +124,8 @@ package body Exp_Aggr is -- constants that are done in place. function Must_Slide - (Obj_Type : Entity_Id; + (Aggr : Node_Id; + Obj_Type : Entity_Id; Typ : Entity_Id) return Boolean; -- A static array aggregate in an object declaration can in most cases be -- expanded in place. The one exception is when the aggregate is given @@ -1776,7 +1777,7 @@ package body Exp_Aggr is if Nkind (Parent (N)) = N_Assignment_Statement and then Is_Array_Type (Comp_Typ) and then Present (Component_Associations (Expr_Q)) - and then Must_Slide (Comp_Typ, Etype (Expr_Q)) + and then Must_Slide (N, Comp_Typ, Etype (Expr_Q)) then Set_Expansion_Delayed (Expr_Q, False); Set_Analyzed (Expr_Q, False); @@ -6855,7 +6856,7 @@ package body Exp_Aggr is and then Parent_Kind = N_Object_Declaration and then Present (Expression (Parent_Node)) and then not - Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ) + Must_Slide (N, Etype (Defining_Identifier (Parent_Node)), Typ) and then not Is_Bit_Packed_Array (Typ) then In_Place_Assign_OK_For_Declaration := True; @@ -9616,13 +9617,16 @@ package body Exp_Aggr is ---------------- function Must_Slide - (Obj_Type : Entity_Id; + (Aggr : Node_Id; + Obj_Type : Entity_Id; Typ : Entity_Id) return Boolean is begin -- No sliding if the type of the object is not established yet, if it is -- an unconstrained type whose actual subtype comes from the aggregate, - -- or if the two types are identical. + -- or if the two types are identical. If the aggregate contains only + -- an Others_Clause it gets its type from the context and no sliding + -- is involved either. if not Is_Array_Type (Obj_Type) then return False; @@ -9633,8 +9637,13 @@ package body Exp_Aggr is elsif Typ = Obj_Type then return False; + elsif Is_Others_Aggregate (Aggr) then + return False; + else -- Sliding can only occur along the first dimension + -- If any the bounds of non-static sliding is required + -- to force potential range checks. declare Bounds1 : constant Range_Nodes := @@ -9648,7 +9657,8 @@ package body Exp_Aggr is not Is_OK_Static_Expression (Bounds1.Last) or else not Is_OK_Static_Expression (Bounds2.Last) then - return False; + return True; + else return Expr_Value (Bounds1.First) /= Expr_Value (Bounds2.First) or else