From patchwork Wed Nov 10 08:58:33 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 47369 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 83D5A3857C4F for ; Wed, 10 Nov 2021 09:04:01 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 83D5A3857C4F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636535041; bh=8zaPBtMGrJ0swjSwNhxYzW2fzbu9yMAIvWQBaN149do=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=gZe0srL66J7m1XQQ9KripqM5co+c5WNlGNLl4YZrLj0NWCjNNFLM1kkrAr+Q/P8Rp U2g8xuQR/HabTs+tEzJjKTY/Nu1fdvzTc3b2zngr6VsqiiTikCMMV9FIyUFFpytEwG j389fUvId/zEqs2tvU7Z/nslpPLbvbqkieED94HM= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lj1-x233.google.com (mail-lj1-x233.google.com [IPv6:2a00:1450:4864:20::233]) by sourceware.org (Postfix) with ESMTPS id AA1A93857C64 for ; Wed, 10 Nov 2021 08:58:36 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org AA1A93857C64 Received: by mail-lj1-x233.google.com with SMTP id 1so3913107ljv.2 for ; Wed, 10 Nov 2021 00:58:36 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=8zaPBtMGrJ0swjSwNhxYzW2fzbu9yMAIvWQBaN149do=; b=yIVP5bzqWGf/UEZdBA4RaPNq/X0Q10yRUaMZZv/obfeqV5y2J69BBGWiI8fjkt5umN YR9MWLffIpPm7jBXCUy+W4dQxPfXs7cV0zmUrv/beQjfcBiOky9et3QssdVVKX2IqcLe geKD26Kl6TpXqI6MyUcjbD7114H67L1V5aVt9FwED4G69a5Mkr1NgSV7HNBWgHKcYE1Y LHpIC6A6Nut4lu1Dcfdo88hoHab1eMoUSvzaIqoJ4XLasa+FjzCn/bZnIhnu9hQc2I5M WtP5v4Asg9/Ok1OSqoPnJ4onV9oOLzJQGEcJ0Ot68uGx/fEC0QnrYQ3YZoe0+nEoQFXh Uw/g== X-Gm-Message-State: AOAM533oxbDADzfT8m7cxjgSl4QTP/DFh6pIpQXvZssidZfYyYrtKPjB fkGw6bc+OnAYRSLdD1zjd6t5dWXUHMnKqpJf X-Google-Smtp-Source: ABdhPJybgXwH4lD9fXLaOTlvlkLzZVpbgAhHgGc/wK2z0V9HFG21tlRleMV+1/3c5HYvTCNEt6tTVw== X-Received: by 2002:a2e:9456:: with SMTP id o22mr923039ljh.129.1636534715504; Wed, 10 Nov 2021 00:58:35 -0800 (PST) Received: from adacore.com ([2a02:2ab8:224:2ce:72b5:e8ff:feef:ee60]) by smtp.gmail.com with ESMTPSA id q9sm1999832lfu.232.2021.11.10.00.58.34 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 10 Nov 2021 00:58:34 -0800 (PST) Date: Wed, 10 Nov 2021 08:58:33 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix oversight in latest change to Has_Compatible_Type Message-ID: <20211110085833.GA2811085@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-13.0 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.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Eric Botcazou Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Adding manual calls to Covers in the callers overlooks the overloaded case, so this follow-up change adds back the reversed calls to Has_Compatible_Type but guard them with a boolean flag set to true for comparison operators. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_type.ads (Has_Compatible_Type): Add For_Comparison parameter. * sem_type.adb (Has_Compatible_Type): Put back the reversed calls to Covers guarded with For_Comparison. * sem_ch4.adb (Analyze_Membership_Op) : Remove new reversed call to Covers and set For_Comparison to true instead. (Find_Comparison_Types) : Likewise (Find_Equality_Types) : Likewise. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3113,7 +3113,7 @@ package body Sem_Ch4 is procedure Try_One_Interp (T1 : Entity_Id) is begin - if Has_Compatible_Type (R, T1) or else Covers (Etype (R), T1) then + if Has_Compatible_Type (R, T1, For_Comparison => True) then if Found and then Base_Type (T1) /= Base_Type (T_F) then @@ -6607,8 +6607,7 @@ package body Sem_Ch4 is end if; if Valid_Comparison_Arg (T1) - and then (Has_Compatible_Type (R, T1) - or else Covers (Etype (R), T1)) + and then Has_Compatible_Type (R, T1, For_Comparison => True) then if Found and then Base_Type (T1) /= Base_Type (T_F) then It := Disambiguate (L, I_F, Index, Any_Type); @@ -7105,8 +7104,8 @@ package body Sem_Ch4 is if T1 /= Standard_Void_Type and then (Universal_Access - or else Has_Compatible_Type (R, T1) - or else Covers (Etype (R), T1)) + or else + Has_Compatible_Type (R, T1, For_Comparison => True)) and then ((not Is_Limited_Type (T1) diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2438,8 +2438,9 @@ package body Sem_Type is ------------------------- function Has_Compatible_Type - (N : Node_Id; - Typ : Entity_Id) return Boolean + (N : Node_Id; + Typ : Entity_Id; + For_Comparison : Boolean := False) return Boolean is I : Interp_Index; It : Interp; @@ -2479,6 +2480,12 @@ package body Sem_Type is or else (Nkind (N) = N_String_Literal and then Present (Find_Aspect (Typ, Aspect_String_Literal))) + + or else + (For_Comparison + and then not Is_Tagged_Type (Typ) + and then Ekind (Typ) /= E_Anonymous_Access_Type + and then Covers (Etype (N), Typ)) then return True; end if; @@ -2503,6 +2510,11 @@ package body Sem_Type is and then Covers (Typ, Corresponding_Record_Type (Etype (It.Typ)))) + or else + (For_Comparison + and then not Is_Tagged_Type (Typ) + and then Ekind (Typ) /= E_Anonymous_Access_Type + and then Covers (It.Typ, Typ)) then return True; end if; diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads --- a/gcc/ada/sem_type.ads +++ b/gcc/ada/sem_type.ads @@ -186,11 +186,17 @@ package Sem_Type is -- right operand, which has one interpretation compatible with that of L. -- Return the type intersection of the two. - function Has_Compatible_Type (N : Node_Id; Typ : Entity_Id) return Boolean; + function Has_Compatible_Type + (N : Node_Id; + Typ : Entity_Id; + For_Comparison : Boolean := False) return Boolean; -- Verify that some interpretation of the node N has a type compatible with -- Typ. If N is not overloaded, then its unique type must be compatible -- with Typ. Otherwise iterate through the interpretations of N looking for - -- a compatible one. + -- a compatible one. If For_Comparison is true, the function is invoked for + -- a comparison (or equality) operator and also needs to verify the reverse + -- compatibility, because the implementation of type resolution for these + -- operators is not fully symmetrical. function Hides_Op (F : Entity_Id; Op : Entity_Id) return Boolean; -- A user-defined function hides a predefined operator if it matches the