From patchwork Tue May 23 08:08:10 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: 97867 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp1977316vqo; Tue, 23 May 2023 01:19:43 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ4UkaJmNzX8WRC9pjcUjS5sfNHwVxGF8hC1FnJTZIdadaBnmDdir87sz/bfBIW448W3A8cO X-Received: by 2002:a17:907:842:b0:966:17b2:5b0b with SMTP id ww2-20020a170907084200b0096617b25b0bmr12253034ejb.49.1684829983056; Tue, 23 May 2023 01:19:43 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1684829983; cv=none; d=google.com; s=arc-20160816; b=WExPEMYQseMO66aPEYWSIhO4JxvZ3UY7a1fppyBYNMtEFslmxaPJ6+xBRuLGk78n6P UBOGdmpORRgRLPabexXPFnIBsZNa211uv3uKGTWm1RgC/KHOLROWYkJslSGYEFn9jMlO +4wLGRRJ+sSvGJfkKT16svCQn2Z9YTx8Pz6WRrIgVQZuNTtyrwRUKsNWYATBfggiOZvN y2G/xbiUqRjB1yC2tyjkdGm+Js/rr/VG/mpjuoy66CZoLvPh/Ycb5IIzUdIqfbyt5nhQ JsqHz07WFMTeFSBBZsKQSC6afys+eaOmgxFua7sRK3U6zLxHnwm2f7C5EdnWqMBL4k1t HxOw== 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=qqV50BtP12zp/npYFI8yylyh3B7l3dueNz9to57LlZY=; b=rpUbEry3342Qzk2AW50eNctaB4v7NpNtdr1Ks/9xqOWc2iCf99O+3frkrWuiUBEo7E gzZDQALavfDC5Xp4RJ2Ia/Phj+KhUKhShopJ928Ss+9kWLn2a4AccKP8+E8MJZilZXD8 uTkNfX5aLCOz2BC3o8nrv2yu/pT70WIHFZpPYCk+b9eft2RVzH4b851drM4+Cdoe9rlW 8GvSLIDffxuKLrAn3oyj9gBorLzGcqT9q/yH/Gza0iSlHPNZSr5XKs4BJvBah27+5uaW 4kntQsn4Nyx2J4Tg4+8In6dg82Z47ddh64gdolqhU6i8xPW+LdN9EP97JaGBamy9CL9M 1vKQ== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=o6HTaF+g; 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 sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id re16-20020a170906d8d000b00969e7cb39f8si1648265ejb.287.2023.05.23.01.19.42 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:19:43 -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=o6HTaF+g; 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 535DD3893659 for ; Tue, 23 May 2023 08:13:10 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 535DD3893659 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684829590; bh=qqV50BtP12zp/npYFI8yylyh3B7l3dueNz9to57LlZY=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=o6HTaF+g7E7/BUfdSOI38YyZSyBqFsNGR9NCGVKWpVyWWKOA6RcXiXT9SJx2Vy+tY fxN4h1sAqPFsuPqOA3zZ1dPReJApmutkQ/e7rgWYXWjhWsProe2zkbMmz4Qhr2XaNX y2uxGyywTQf0R8QjRb9m9nFEnjn4GLM2YStkI69E= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x334.google.com (mail-wm1-x334.google.com [IPv6:2a00:1450:4864:20::334]) by sourceware.org (Postfix) with ESMTPS id 17B383836E9F for ; Tue, 23 May 2023 08:08:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 17B383836E9F Received: by mail-wm1-x334.google.com with SMTP id 5b1f17b1804b1-3f605d8a8a9so17687085e9.0 for ; Tue, 23 May 2023 01:08:13 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684829292; x=1687421292; 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=qqV50BtP12zp/npYFI8yylyh3B7l3dueNz9to57LlZY=; b=kxPaVKTEo0qFBLnZqjMl1Mj8tN78KZBLFrXvnq0eAlQPiXcG9OIYUNDSuNhg3hv5Sm aeS0pjMpn6v/Kp3F52M6PSyZtI8iWrLJIG4vHSe9+amHm/TXa+6HLBy1gl77Fwo8+fV+ kBHrZGWqttx2TphvWWT1m6Ufm4E8cEB5o8lirllBtP05EgW2KVbU31DkBbwDaU5X5CUe 5Y0q/AHhSOE2Yt6BJbCHXlGYNfKg3+pTGfCencm5yeV4LIim87asKCSA5jwDNj+a8tPY 5RQI5OqmhCAHikPSyWZK6l0mEErsum22qUHCnAa7YpGlZVElwAhw76mTRALSf3Z/7s6c GXEg== X-Gm-Message-State: AC+VfDyt1nRaKGF5/fmstTuK0nwszqa0hy12stFheKvzLDLb5agmut8l nCx/xv93X1PtMzZrg3u1e1i+c0/CJsZpCXrDhbqwKw== X-Received: by 2002:a7b:c8ce:0:b0:3f6:15f:e401 with SMTP id f14-20020a7bc8ce000000b003f6015fe401mr5554047wml.37.1684829291830; Tue, 23 May 2023 01:08:11 -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 c17-20020a7bc011000000b003f31cb7a203sm10799938wmb.14.2023.05.23.01.08.10 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:08:11 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix internal error on quantified expression with predicated type Date: Tue, 23 May 2023 10:08:10 +0200 Message-Id: <20230523080810.1873414-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, 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?1766672284368107247?= X-GMAIL-MSGID: =?utf-8?q?1766672284368107247?= From: Eric Botcazou The problem is that the special function created by the compiler to check the predicate does not inherit the public status of the type, because it is generated as part of the freezing of the quantified expression, which occurs from within a couple of intermediate internal scopes. gcc/ada/ * sem_ch13.adb (Build_Predicate_Function_Declaration): Adjust the commentary to the current implementation. * sem_util.ads (Current_Scope_No_Loops): Move around. (Current_Scope_No_Loops_No_Blocks): New declaration. (Add_Block_Identifier): Fix formatting. * sem_util.adb (Add_Block_Identifier): Likewise. (Current_Scope_No_Loops_No_Blocks): New function. (Set_Public_Status): Call Current_Scope_No_Loops_No_Blocks instead of Current_Scope to get the current scope. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch13.adb | 4 +--- gcc/ada/sem_util.adb | 35 ++++++++++++++++++++++++++++++----- gcc/ada/sem_util.ads | 15 +++++++++------ 3 files changed, 40 insertions(+), 14 deletions(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9ece773304a..d1458f58784 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -133,9 +133,7 @@ package body Sem_Ch13 is function Build_Predicate_Function_Declaration (Typ : Entity_Id) return Node_Id; -- Build the declaration for a predicate function. The declaration is built - -- at the end of the declarative part containing the type definition, which - -- may be before the freeze point of the type. The predicate expression is - -- preanalyzed at this point, to catch visibility errors. + -- at the same time as the body but inserted before, as explained below. procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id); -- If Typ has predicates (indicated by Has_Predicates being set for Typ), diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 391cade9eac..c8599d47593 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -312,11 +312,12 @@ package body Sem_Util is -------------------------- procedure Add_Block_Identifier - (N : Node_Id; - Id : out Entity_Id; - Scope : Entity_Id := Current_Scope) + (N : Node_Id; + Id : out Entity_Id; + Scope : Entity_Id := Current_Scope) is Loc : constant Source_Ptr := Sloc (N); + begin pragma Assert (Nkind (N) = N_Block_Statement); @@ -331,7 +332,6 @@ package body Sem_Util is Id := New_Internal_Entity (E_Block, Scope, Loc, 'B'); Set_Etype (Id, Standard_Void_Type); Set_Parent (Id, N); - Set_Identifier (N, New_Occurrence_Of (Id, Loc)); Set_Block_Node (Id, Identifier (N)); end if; @@ -6721,6 +6721,31 @@ package body Sem_Util is return S; end Current_Scope_No_Loops; + -------------------------------------- + -- Current_Scope_No_Loops_No_Blocks -- + -------------------------------------- + + function Current_Scope_No_Loops_No_Blocks return Entity_Id is + S : Entity_Id; + + begin + -- Examine the scope stack starting from the current scope and skip any + -- internally generated loops and blocks. + + S := Current_Scope; + while Present (S) and then S /= Standard_Standard loop + if Ekind (S) in E_Loop | E_Block + and then not Comes_From_Source (S) + then + S := Scope (S); + else + exit; + end if; + end loop; + + return S; + end Current_Scope_No_Loops_No_Blocks; + ------------------------ -- Current_Subprogram -- ------------------------ @@ -27724,7 +27749,7 @@ package body Sem_Util is ----------------------- procedure Set_Public_Status (Id : Entity_Id) is - S : constant Entity_Id := Current_Scope; + S : constant Entity_Id := Current_Scope_No_Loops_No_Blocks; function Within_HSS_Or_If (E : Entity_Id) return Boolean; -- Determines if E is defined within handled statement sequence or diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 7bb8cdbe3f3..3edc158c749 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -639,18 +639,21 @@ package Sem_Util is function Current_Scope return Entity_Id; -- Get entity representing current scope + function Current_Scope_No_Loops return Entity_Id; + -- Return the current scope ignoring internally generated loops + + function Current_Scope_No_Loops_No_Blocks return Entity_Id; + -- Return the current scope ignoring internally generated loops and blocks + procedure Add_Block_Identifier - (N : Node_Id; - Id : out Entity_Id; - Scope : Entity_Id := Current_Scope); + (N : Node_Id; + Id : out Entity_Id; + Scope : Entity_Id := Current_Scope); -- Given a block statement N, generate an internal E_Block label and make -- it the identifier of the block. Scope denotes the scope in which the -- generated entity Id is created and defaults to the current scope. If the -- block already has an identifier, Id returns the entity of its label. - function Current_Scope_No_Loops return Entity_Id; - -- Return the current scope ignoring internally generated loops - function Current_Subprogram return Entity_Id; -- Returns current enclosing subprogram. If Current_Scope is a subprogram, -- then that is what is returned, otherwise the Enclosing_Subprogram of the