From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id CA7513894C2F for ; Mon, 30 Nov 2020 14:17:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org CA7513894C2F Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5ED6F561E9; Mon, 30 Nov 2020 09:17:12 -0500 (EST) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id m-rFQZg3wtvV; Mon, 30 Nov 2020 09:17:12 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 2C978561E4; Mon, 30 Nov 2020 09:17:12 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id 2BB16CB; Mon, 30 Nov 2020 09:17:12 -0500 (EST) Date: Mon, 30 Nov 2020 09:17:12 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Arnaud Charlet Subject: [Ada] Wrong replacement of Component.Discriminant Message-ID: <20201130141712.GA117900@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="SUOF0GtieIMvvwua" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-11.2 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 30 Nov 2020 14:17:21 -0000 --SUOF0GtieIMvvwua Content-Type: text/plain; charset=us-ascii Content-Disposition: inline The procedure Replace_Discr_Ref added a few years ago is overzealous and triggers in too many cases in the case of multiple records with discriminants involved. It appears that this procedure is no longer needed at this stage, so simply remove it. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_ch3.adb (Replace_Discr_Ref): Removed, no longer needed. --SUOF0GtieIMvvwua Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2008,47 +2008,6 @@ package body Exp_Ch3 is Lhs : Node_Id; Res : List_Id; - function Replace_Discr_Ref (N : Node_Id) return Traverse_Result; - -- Analysis of the aggregate has replaced discriminants by their - -- corresponding discriminals, but these are irrelevant when the - -- component has a mutable type and is initialized with an aggregate. - -- Instead, they must be replaced by the values supplied in the - -- aggregate, that will be assigned during the expansion of the - -- assignment. - - ----------------------- - -- Replace_Discr_Ref -- - ----------------------- - - function Replace_Discr_Ref (N : Node_Id) return Traverse_Result is - Val : Node_Id; - - begin - if Is_Entity_Name (N) - and then Present (Entity (N)) - and then Is_Formal (Entity (N)) - and then Present (Discriminal_Link (Entity (N))) - then - Val := - Make_Selected_Component (Default_Loc, - Prefix => New_Copy_Tree (Lhs), - Selector_Name => - New_Occurrence_Of - (Discriminal_Link (Entity (N)), Default_Loc)); - - if Present (Val) then - Rewrite (N, New_Copy_Tree (Val)); - end if; - end if; - - return OK; - end Replace_Discr_Ref; - - procedure Replace_Discriminant_References is - new Traverse_Proc (Replace_Discr_Ref); - - -- Start of processing for Build_Assignment - begin Lhs := Make_Selected_Component (Default_Loc, @@ -2056,22 +2015,6 @@ package body Exp_Ch3 is Selector_Name => New_Occurrence_Of (Id, Default_Loc)); Set_Assignment_OK (Lhs); - if Nkind (Exp) = N_Aggregate - and then Has_Discriminants (Typ) - and then not Is_Constrained (Base_Type (Typ)) - then - -- The aggregate may provide new values for the discriminants - -- of the component, and other components may depend on those - -- discriminants. Previous analysis of those expressions have - -- replaced the discriminants by the formals of the initialization - -- procedure for the type, but these are irrelevant in the - -- enclosing initialization procedure: those discriminant - -- references must be replaced by the values provided in the - -- aggregate. - - Replace_Discriminant_References (Exp); - end if; - -- Case of an access attribute applied to the current instance. -- Replace the reference to the type by a reference to the actual -- object. (Note that this handles the case of the top level of --SUOF0GtieIMvvwua--