From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: 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 082533849AF4 for ; Thu, 16 May 2024 09:26:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 082533849AF4 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 082533849AF4 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::332 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1715851585; cv=none; b=CAQC4zwmUkBWazqlZE1zDGOfpOaIFYB/q0GL7eINULhijH8ktKERHdBO2hPtoun0O/VhgpaLUFF4AEk9slq31D1F3FXUex3aT4zlXUx5+A5CGoPYSZd89B5Kkp8sBEsqQ6CisGm9d9G0A/u2ecEhAsrO2WmNtzj92SLYhYr/Kvs= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1715851585; c=relaxed/simple; bh=qxFs99ZR0gY5ixxj+rjNXbjOZVUeGjDShQxB/qgynrk=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=yCGx/mWFXdIB7qSPzSBJcVcA6LgkaV+2wtmhrKO5UwI82Rf/DbYPhJKHFhSf628yHsnom/bxyhaPlPLqtJq5oQOjID6iFBnZnCAIeQJI1y2sGIlJXbGVIcrALD7YZgnvkjjyFcJCdK4iLONdx3hbt7pTJg2Kjk2mZLFbvGs9FF4= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x332.google.com with SMTP id 5b1f17b1804b1-420104e5336so31476075e9.1 for ; Thu, 16 May 2024 02:26:20 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1715851580; x=1716456380; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=wqiUoJypxQszvZZOZNvN7hnFd+6wNdvYzifFjGPg/Bs=; b=KZsOTPgR64hu3sTKYBNbLBU/Y470N6Wj+IPrr1qqddqXjWALeqQZp2rnwRLQCgvV25 HOjQZiT6IWWtvoKyyYxlLt05LHgdHTVXdpnAF5r2vya00J6XGWCEAVy+DzUuZtF90+gB 4hGPrHGyt+ykVLnzOpulsYj/L4qM8zv1exeWT/1MmG2QowBXqI/0h9uTr8hnY5jNuil2 BI1nTVuhYH1U98yaN7ekvbVcTT1d8e9b134xoQIG113pwJRNSERJbAfVfN2vP5wtSCTt 4UPSet5/sCwgCa8feKy3we+W/aPSWd9Lb4Qz28l+sPnudKzQ5cGs2teXuvDg+rFkEVR3 4qXA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1715851580; x=1716456380; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=wqiUoJypxQszvZZOZNvN7hnFd+6wNdvYzifFjGPg/Bs=; b=oI80H1UbddzIPuToKb98zZBtcCB5B/0ohU5fn7vlzOwcWsYcz0TBliD542STnEukrQ fCNc08r0zQknYaa1yh+HwGhqCr0QsUY8fpVF5pFd751I1HXLf70VDOk/0yUWxdMSHNb0 cMDfmBOMDB1W7e1bz/CsBXVnBGn9Oi/dTRYEW1+PmkY35COdTiF6gut1L944ai+oube4 EkZU8JVLK515ZaMzJJcb1T561WVnf6bVP4imroQcVFaLa/JGBfYtlsPLSYC92cXdqxa2 PpIT0VhBX/9Cr5LEg33lHP9if5euuSqESQzbVNzq8tu6VJsFYidEA3bNEhLr/VZ7apf1 Vm3Q== X-Gm-Message-State: AOJu0Yzj/xhfgEtfS8WSPqRlK5Bla2rnsg9X7y9royHuxfD/RHPk2P18 ZvUiHVd55h7xJZCJAQl1FuSIjT4mHntAyPRoLnSIhmIBNu3XitLvnEbB/llrBO80XXdYGzG03oI = X-Google-Smtp-Source: AGHT+IHg47NA7MrfebuSemGlUnehq8y8KADfpEttLgb16jLXWQzWPtLVK1Ekd0Y55Y49kYuUlRIiOg== X-Received: by 2002:a05:600c:458f:b0:418:3d59:c13a with SMTP id 5b1f17b1804b1-41fbcb4fe53mr193421385e9.9.1715851579782; Thu, 16 May 2024 02:26:19 -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 5b1f17b1804b1-41fd10cf8besm135802635e9.1.2024.05.16.02.26.19 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 May 2024 02:26:19 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 14/35] ada: Fix bogus error on function returning noncontrolling result in private part Date: Thu, 16 May 2024 11:25:43 +0200 Message-ID: <20240516092606.41242-14-poulhies@adacore.com> X-Mailer: git-send-email 2.43.2 In-Reply-To: <20240516092606.41242-1-poulhies@adacore.com> References: <20240516092606.41242-1-poulhies@adacore.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit 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 autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: From: Eric Botcazou This occurs in the additional case of RM 3.9.3(10) in Ada 2012, that is to say the access controlling result, because the implementation does not use the same (correct) conditions as in the original case. This factors out these conditions and uses them in both cases, as well as adjusts the wording of the message in the first case. gcc/ada/ * sem_ch6.adb (Check_Private_Overriding): Implement the second part of RM 3.9.3(10) consistently in both cases. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch6.adb | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c0bfe873111..0a8030cb923 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -11555,35 +11555,30 @@ package body Sem_Ch6 is Incomplete_Or_Partial_View (T); begin - if not Overrides_Visible_Function (Partial_View) then + if not Overrides_Visible_Function (Partial_View) + and then + Is_Tagged_Type + (if Present (Partial_View) then Partial_View else T) + then -- Here, S is "function ... return T;" declared in -- the private part, not overriding some visible -- operation. That's illegal in the tagged case -- (but not if the private type is untagged). - if ((Present (Partial_View) - and then Is_Tagged_Type (Partial_View)) - or else (No (Partial_View) - and then Is_Tagged_Type (T))) - and then T = Base_Type (Etype (S)) - then + if T = Base_Type (Etype (S)) then Error_Msg_N - ("private function with tagged result must" + ("private function with controlling result must" & " override visible-part function", S); Error_Msg_N ("\move subprogram to the visible part" & " (RM 3.9.3(10))", S); -- Ada 2012 (AI05-0073): Extend this check to the case - -- of a function whose result subtype is defined by an - -- access_definition designating specific tagged type. + -- of a function with access result type. elsif Ekind (Etype (S)) = E_Anonymous_Access_Type - and then Is_Tagged_Type (Designated_Type (Etype (S))) - and then - not Is_Class_Wide_Type - (Designated_Type (Etype (S))) + and then T = Base_Type (Designated_Type (Etype (S))) and then Ada_Version >= Ada_2012 then Error_Msg_N -- 2.43.2