From patchwork Tue Jul 18 13:13:31 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 122013 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:c923:0:b0:3e4:2afc:c1 with SMTP id j3csp1737624vqt; Tue, 18 Jul 2023 06:16:09 -0700 (PDT) X-Google-Smtp-Source: APBJJlG17m+NF/uLMHtS5T5rfMNLvX+dfK97k7TJaCzemOJySYBbt4fctTEbYk/TVWeu+sHbFg1J X-Received: by 2002:a19:500b:0:b0:4fb:774f:9a84 with SMTP id e11-20020a19500b000000b004fb774f9a84mr8450362lfb.13.1689686168854; Tue, 18 Jul 2023 06:16:08 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1689686168; cv=none; d=google.com; s=arc-20160816; b=brH9pAsuhLXG+tPoHExFIBsw3Rb1Dqf8kqGfbec1uIf44Ljela7BIyl4ENcBQTlnGZ en9neCqbeq6t0IDs+YB75pQM/4M4YQbiXg58hGBctxwzMNkELvDj8rdoJwdq2IKbSUr+ 5hgbYHoRyHPuDNr5ZJx80BerGkfCEI5nY1C8I/4fmexxWA7KDzi+xCzlxu0ftST/5wn1 XQ98YVgIY2WTb8ZDijZdpcUJvea75Pcv9llqGRFb7fk3H5F3MsPe3eVm5Q6t+BVGFLvG GoUdeXtq/fS1FazONXsanFvnZ8KOIG0FoWJx7IztVKUK46d4eQimmuKmONjkpIy59qIU oEVQ== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence :content-transfer-encoding:mime-version:message-id:date:subject:cc :to:dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=XAzBkLoKGx++iww0dx/4qXCrUUpZVche5oITlUbu9Ak=; fh=/3KX5nH+f3PGIzCwnuf//1E+cbLgxv/xavy4NboKqC4=; b=HZR4O35fpJXpNAar4H5o72EpB9wDi+MfMuWe8UV8XiiAWdxB7cXZoq381p1lVEogmQ 9Pgo1UJ275+JgySXuvt4HGw4UBezifxS9cXKwWFhAKQNHCT73rdp8r5U7EotmSUSkTcu p7VRFPZXyFDFC41hjuQ7yw1iC6SyJqqT4y3Ls+xFOMmRTiDqg2PCdY40uAhB/ZesHR/s 8J7JzUinFvQHQzZBuAzF4oIXTws6BzbrF28hjbl6XMwGfOD1kyI0icpi/SjhOFF50EWR ZL/CPOIkhIYUMXM5Zd/MrVxYb2s8i0sM1jalUv7F5mTVhPpKlfvyDnDcZppo89ejzAQw RQqg== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=lpTWaBuN; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id j8-20020a170906254800b00997dfeb04a1si966678ejb.70.2023.07.18.06.16.08 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 18 Jul 2023 06:16:08 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=lpTWaBuN; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id AA0553876892 for ; Tue, 18 Jul 2023 13:14:32 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AA0553876892 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1689686072; bh=XAzBkLoKGx++iww0dx/4qXCrUUpZVche5oITlUbu9Ak=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=lpTWaBuNOrApVeg1T9wkN5R/iloO0eXpnFzLerRoMDRfk7IfgX6jiipiJabmjzWRr rVodnH+CqQfvuBzDUAoyejST9ngJDYkxJGf+WZW0D7L4q+VdYUZKeLSS6oIVRFl/TN oXMQmgkgXP3hKKp5i4N3B/Bfe1zp9ouHSPmiLFRo= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id 073543857019 for ; Tue, 18 Jul 2023 13:13:34 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 073543857019 Received: by mail-wr1-x42f.google.com with SMTP id ffacd0b85a97d-317009c0f9aso2278510f8f.0 for ; Tue, 18 Jul 2023 06:13:33 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1689686013; x=1690290813; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=XAzBkLoKGx++iww0dx/4qXCrUUpZVche5oITlUbu9Ak=; b=UcQmf8g7Y3if+PXyEPBLjTMoXg7MpR5nu/cw2QwFanYNvKjRh5wlQDZV1CfPF7lw+8 o0KzG3SJOKr2A69YftYXVEUO4RYwdHoVBmWvKVDHRItp4TxanEQXwnDfsGzchGhRNzLH HIgR1r+keyex68HSGfHLPuCKzySdiTLQ+62BvvnrpZvjZurkF7XTIDbzti9F1yFlnDty 3FaOkp0+pvUvd1F4VlJlvD1LESiC+YLTsR+TXBkKhmwxSwuZdoCJCDjBn+J3qsaWm0CJ R4fuDQ0nHLAOBK+lpH2FcWzvPJY9ePPUNeedmDZBjPUBKXb9FodR5sRnkYzkO+ulTJ3e r8MA== X-Gm-Message-State: ABy/qLY9zH4gXwjvHAa9raxAcFtCVRpqS8xixYxfWPm5JbUYf7YX2fR/ ffRnbv2wI12CPjR7/KrQUEUoiu/58c0Ew/KHQtstIw== X-Received: by 2002:a5d:40ca:0:b0:313:f02f:be7f with SMTP id b10-20020a5d40ca000000b00313f02fbe7fmr12458872wrq.55.1689686012774; Tue, 18 Jul 2023 06:13:32 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id z17-20020a5d6411000000b00314145e6d61sm2415687wru.6.2023.07.18.06.13.32 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 18 Jul 2023 06:13:32 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix internal error on aggregates of self-referencing types Date: Tue, 18 Jul 2023 15:13:31 +0200 Message-Id: <20230718131331.81070-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1771764364345714747 X-GMAIL-MSGID: 1771764364345714747 From: Eric Botcazou The front-end contains a specific mechanism to deal with aggregates of self-referencing types by means of the Has_Self_Reference flag, which is supposed to be set during semantic analysis and used during expansion. The problem is that the first part overlooks aggregates of derived types which implicitly contain references to an ancestor type (the second part uses a broader condition but it is effectively guarded by the first one). This changes both parts to use the same condition based on the Is_Ancestor predicate, which seems to implement the expected semantic in this case. gcc/ada/ * sem_type.ads (Is_Ancestor): Remove mention of tagged type. * exp_aggr.adb: Add with and use clauses for Sem_Type. (Build_Record_Aggr_Code.Replace_Type): Call Is_Ancestor to spot self-references to the type of the aggregate. * sem_aggr.adb (Resolve_Record_Aggregate.Add_Discriminant_Values): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 13 ++++++++----- gcc/ada/sem_aggr.adb | 11 +++++++---- gcc/ada/sem_type.ads | 7 +++---- 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index d922c3bf1a4..4c8dcae9d83 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -61,6 +61,7 @@ with Sem_Ch13; use Sem_Ch13; with Sem_Eval; use Sem_Eval; with Sem_Mech; use Sem_Mech; with Sem_Res; use Sem_Res; +with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; use Sem_Util.Storage_Model_Support; with Sinfo; use Sinfo; @@ -2760,19 +2761,21 @@ package body Exp_Aggr is function Replace_Type (Expr : Node_Id) return Traverse_Result is begin - -- Note regarding the Root_Type test below: Aggregate components for + -- Note about the Is_Ancestor test below: aggregate components for -- self-referential types include attribute references to the current - -- instance, of the form: Typ'access, etc.. These references are + -- instance, of the form: Typ'access, etc. These references are -- rewritten as references to the target of the aggregate: the -- left-hand side of an assignment, the entity in a declaration, - -- or a temporary. Without this test, we would improperly extended - -- this rewriting to attribute references whose prefix was not the + -- or a temporary. Without this test, we would improperly extend + -- this rewriting to attribute references whose prefix is not the -- type of the aggregate. if Nkind (Expr) = N_Attribute_Reference and then Is_Entity_Name (Prefix (Expr)) and then Is_Type (Entity (Prefix (Expr))) - and then Root_Type (Etype (N)) = Root_Type (Entity (Prefix (Expr))) + and then + Is_Ancestor + (Entity (Prefix (Expr)), Etype (N), Use_Full_View => True) then if Is_Entity_Name (Lhs) then Rewrite (Prefix (Expr), New_Occurrence_Of (Entity (Lhs), Loc)); diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 39189463871..5bfbde5052b 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -4546,14 +4546,17 @@ package body Sem_Aggr is Component_Associations (New_Aggr)); -- If the discriminant constraint is a current instance, mark the - -- current aggregate so that the self-reference can be expanded - -- later. The constraint may refer to the subtype of aggregate, so - -- use base type for comparison. + -- current aggregate so that the self-reference can be expanded by + -- Build_Record_Aggr_Code.Replace_Type later. if Nkind (Discr_Val) = N_Attribute_Reference and then Is_Entity_Name (Prefix (Discr_Val)) and then Is_Type (Entity (Prefix (Discr_Val))) - and then Base_Type (Etype (N)) = Entity (Prefix (Discr_Val)) + and then + Is_Ancestor + (Entity (Prefix (Discr_Val)), + Etype (N), + Use_Full_View => True) then Set_Has_Self_Reference (N); end if; diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads index 6bc776a7319..e867885dac6 100644 --- a/gcc/ada/sem_type.ads +++ b/gcc/ada/sem_type.ads @@ -222,10 +222,9 @@ package Sem_Type is (T1 : Entity_Id; T2 : Entity_Id; Use_Full_View : Boolean := False) return Boolean; - -- T1 is a tagged type (not class-wide). Verify that it is one of the - -- ancestors of type T2 (which may or not be class-wide). If Use_Full_View - -- is True then the full-view of private parents is used when climbing - -- through the parents of T2. + -- T1 is a type (not class-wide). Verify that it is one of the ancestors of + -- type T2 (which may or not be class-wide). If Use_Full_View is True, then + -- the full view of private parents is used when climbing T2's parents. -- -- Note: For analysis purposes the flag Use_Full_View must be set to False -- (otherwise we break the privacy contract since this routine returns true