From patchwork Tue May 23 08:08:06 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: 97878 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp1979480vqo; Tue, 23 May 2023 01:25:09 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ5RI7Np+rRGjkGEyqc7XqivNg2bLVN74MKuNTHtd09YTPxeCgZxS3Q0+jvRgijcTChVbyzq X-Received: by 2002:aa7:d419:0:b0:50c:4b1:8912 with SMTP id z25-20020aa7d419000000b0050c04b18912mr11167158edq.15.1684830309372; Tue, 23 May 2023 01:25:09 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1684830309; cv=none; d=google.com; s=arc-20160816; b=n8loTscXFg5U9Cr/YZ1k3DIs7iuwdCtqZIZe0nULw0BMiNyxk2Cx8jOjJdI0kzGATz B70HD+WiJly4L3FOkdw29B4u0ypQc68GTH0u5SOqx/bYquACbpQmh6ljqyw+XnvUFtbZ Gs4S7oJ/fOk2YqkmjFxCCjBbE0ML6hYo/q6m3w2Dg2MDIFDCdvlt434dAocQTCv2tbET eSLaBOG753RkTVxuio3HwrYD2iP+7xjno92dSJn4HQ3LxfhHrRgs7f0gSeTfDwFZhw4Z FKgzQHhOrCkI4VZ+ehgC4uglKEJLXVUTcK8aOWKbe0VxBBRBI8zVUjbUqYHW2DGzOyGP 4IfA== 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=jKByQw4cTWbYNaaQAEU0I8bwRwhufwv9jRHwQRw16XE=; b=kK0MyarZXMjSbvD0wm8xmOw8Q7PIn5AOQc0yzXWeXt5EGtQAOATK/BI2QxiPUWBGRk 5bVHe8dAPe0rGY9Xz2o/fR/A/pj90XUDtEcBpFqW5k9xS6y2ueZs5oVzk9GL4xGcFbqv I4hjfkEtFdOERJYdNXjtUFfeelWDb6tT+GA0aVTNvTtfCQFioeKV6u2t2tcsT89GUfT0 2FhQQdu1ppX+zJNdkUWakO2CQOUyFe9eIFEzCaqwRrY3RTklMcj0nYs8qBiwMoZ+uDuY u7YMQm2XoJxDVuWecTpjlBHeUoZ75kOFRQOTVt7WvSzASFGlvPSHIp2B9PZ8ZDAtrmd6 e6KQ== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=yTGlkqQI; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c 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 sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id c3-20020a056402120300b005047b5d4479si3832367edw.415.2023.05.23.01.25.09 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:25:09 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=yTGlkqQI; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c 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 504B338323F4 for ; Tue, 23 May 2023 08:15:48 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 504B338323F4 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684829748; bh=jKByQw4cTWbYNaaQAEU0I8bwRwhufwv9jRHwQRw16XE=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=yTGlkqQIogjOUPCBDUzYfrieZfSJ5vtzyTypQxt677Zq4IhCS3qw3IBbtngk1NjcI U75Hw2qmKfy9xpXyrQ4sIlGiuglwuRhTk1e8zF0dGrLo64YHFTS3Z/SxnI4VQffpwV Z4ZlOzH9VDCpacvcberM4ko3dXsKMNzvjduHTiyA= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x332.google.com (mail-wm1-x332.google.com [IPv6:2a00:1450:4864:20::332]) by sourceware.org (Postfix) with ESMTPS id 311E93839DEF for ; Tue, 23 May 2023 08:08:09 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 311E93839DEF Received: by mail-wm1-x332.google.com with SMTP id 5b1f17b1804b1-3f60b3f32b4so2455605e9.1 for ; Tue, 23 May 2023 01:08:09 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684829288; x=1687421288; 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=jKByQw4cTWbYNaaQAEU0I8bwRwhufwv9jRHwQRw16XE=; b=fiZO0wBKPK0G6ATetVXk29Sq7wMYXI/1gzMcXg5aafTP8g2s0qxXQ7rH3DB/tWCaAC YlwgIXmoKwyiPO9aGZjm8jbn7ZWBsT78XSDtRRfuSq3gVIYx8D2OzEPgpKV+egBTHjTj mGQKnoaa95Omx0UKvkdVhLCAkr9FjvHczg+ev9xhPegmKRPoacR7T9cMzXJXuxowzHDv kFM8OMhJAwUWUJsJZ/vMWvEt0gbnkvh4SjeIYYIxvtLYzyizSs8RsaN7qsn7CE8MgMGR xq5AyzOkJSkhzYY/tQVR5V8jguraMaMA/V5jZ8j46lueh5DK/rM5hMeOYZUxH0HfrGJm G2VQ== X-Gm-Message-State: AC+VfDwAw5IUB1Wdjrz1Bzfnw0OxRDJAcXztUFyX0YlbUC6reIVxUQz2 aB+oFvNx6lZBRUbv3ivhBpaBM7b3jrYmasHkGUnuzg== X-Received: by 2002:a7b:ce95:0:b0:3f4:2b13:f0fb with SMTP id q21-20020a7bce95000000b003f42b13f0fbmr4086100wmj.13.1684829288030; Tue, 23 May 2023 01:08:08 -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 f20-20020a7bc8d4000000b003f6038faa19sm7030093wml.19.2023.05.23.01.08.07 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:08:07 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix bogus error on predicated limited record declared in protected type Date: Tue, 23 May 2023 10:08:06 +0200 Message-Id: <20230523080806.1873350-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.6 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: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1766672626163611006?= X-GMAIL-MSGID: =?utf-8?q?1766672626163611006?= From: Eric Botcazou This happens when the limited record is initialized with a function call because of a couple of issues: incorrect tree sharing when building the predicate check and too late freezing for a compiler-generated subtype. It turns out that building the predicate check manually is redundant here, since predicate checks are automatically generated during the expansion of assignment statements, and the late freezing can be easily fixed. gcc/ada/ * exp_ch3.adb (Build_Record_Init_Proc.Build_Assignment): Do not manually generate a predicate check. Call Unqualify before doing pattern matching on the expression. * sem_ch3.adb (Analyze_Object_Declaration): Also freeze the actual subtype when it is built in the definite case. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch3.adb | 31 +++++++++---------------------- gcc/ada/sem_ch3.adb | 1 + 2 files changed, 10 insertions(+), 22 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 3a023092532..b992a587433 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2082,8 +2082,8 @@ package body Exp_Ch3 is Typ : constant Entity_Id := Underlying_Type (Etype (Id)); Adj_Call : Node_Id; - Exp : Node_Id := Default; - Kind : Node_Kind := Nkind (Default); + Exp : Node_Id; + Exp_Q : Node_Id; Lhs : Node_Id; Res : List_Id; @@ -2094,13 +2094,14 @@ package body Exp_Ch3 is Selector_Name => New_Occurrence_Of (Id, Default_Loc)); Set_Assignment_OK (Lhs); - -- Take a copy of Exp to ensure that later copies of this component + -- Take copy of Default to ensure that later copies of this component -- declaration in derived types see the original tree, not a node -- rewritten during expansion of the init_proc. If the copy contains -- itypes, the scope of the new itypes is the init_proc being built. declare Map : Elist_Id := No_Elist; + begin if Has_Late_Init_Comp then -- Map the type to the _Init parameter in order to @@ -2131,7 +2132,7 @@ package body Exp_Ch3 is end if; end if; - Exp := New_Copy_Tree (Exp, New_Scope => Proc_Id, Map => Map); + Exp := New_Copy_Tree (Default, New_Scope => Proc_Id, Map => Map); end; Res := New_List ( @@ -2141,6 +2142,8 @@ package body Exp_Ch3 is Set_No_Ctrl_Actions (First (Res)); + Exp_Q := Unqualify (Exp); + -- Adjust the tag if tagged (because of possible view conversions). -- Suppress the tag adjustment when not Tagged_Type_Expansion because -- tags are represented implicitly in objects, and when the record is @@ -2148,9 +2151,7 @@ package body Exp_Ch3 is if Is_Tagged_Type (Typ) and then Tagged_Type_Expansion - and then Nkind (Exp) /= N_Raise_Expression - and then (Nkind (Exp) /= N_Qualified_Expression - or else Nkind (Expression (Exp)) /= N_Raise_Expression) + and then Nkind (Exp_Q) /= N_Raise_Expression then Append_To (Res, Make_Assignment_Statement (Default_Loc, @@ -2173,12 +2174,8 @@ package body Exp_Ch3 is -- Adjust the component if controlled except if it is an aggregate -- that will be expanded inline. - if Kind = N_Qualified_Expression then - Kind := Nkind (Expression (Default)); - end if; - if Needs_Finalization (Typ) - and then Kind not in N_Aggregate | N_Extension_Aggregate + and then Nkind (Exp_Q) not in N_Aggregate | N_Extension_Aggregate and then not Is_Build_In_Place_Function_Call (Exp) then Adj_Call := @@ -2194,16 +2191,6 @@ package body Exp_Ch3 is end if; end if; - -- If a component type has a predicate, add check to the component - -- assignment. Discriminants are handled at the point of the call, - -- which provides for a better error message. - - if Comes_From_Source (Exp) - and then Predicate_Enabled (Typ) - then - Append (Make_Predicate_Check (Typ, Exp), Res); - end if; - return Res; exception diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 2ebbe36abc6..bace2cf616a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4971,6 +4971,7 @@ package body Sem_Ch3 is end if; Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc)); + Freeze_Before (N, Act_T); elsif Nkind (E) = N_Function_Call and then Constant_Present (N)