From patchwork Tue May 10 08:21:12 2022 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: 53721 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 9F4AA3948A67 for ; Tue, 10 May 2022 09:00:31 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 9F4AA3948A67 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1652173231; bh=eocmiyXRHGBw8jgpFRTC7o/uJHpoXfyommShDKwOhD8=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=ZphubdgHHPPo2ydlq7b8xys+h0PGi363a4AUnwB9DGeXGXX0S2hij2uwigSJJCy86 ZPR6pxDAEaIRP9qBXOwpk9QWmUnYpMyAIAqJEzlecpOcQTOtVXwIyLmtnNDOxPuyoU KrQrahkbKIYZtqP5QjPMmbU/pxbtTqCgOHKwnH/U= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x435.google.com (mail-wr1-x435.google.com [IPv6:2a00:1450:4864:20::435]) by sourceware.org (Postfix) with ESMTPS id 69C333838001 for ; Tue, 10 May 2022 08:21:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 69C333838001 Received: by mail-wr1-x435.google.com with SMTP id e2so22655001wrh.7 for ; Tue, 10 May 2022 01:21:13 -0700 (PDT) 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=eocmiyXRHGBw8jgpFRTC7o/uJHpoXfyommShDKwOhD8=; b=lqbWwD9JmJ9czvFZ5CmVGYyD0vxgHh9IkkIMiBfI6CcdPmzb9XXSVs/sMzkpGVCpCS PGQNJukwg0wpjhyj6nQpcpiMSKLeuTLvky8wIJznC8vIyZp6Sd1Gch5P/3O7ijB/ROVm PFXZ6XbTwEuMEQqSYD+K7luXvHgLLbiR4P4YvW/pnJkY62/XDIWdn5ce4NYQb16PSJ2X EY9vTunC3IsDkOKNhk9hj7Cc2d/1c52lBXttUxXmDtuIAeCUQruEXOcI9r8nx1/vTya7 0+MaQTJnalfaXEW44N391+2oUTXLaWirqke3kP1nw6oCLAbPsAJYkBd1CgrbDsnByg5+ l/IQ== X-Gm-Message-State: AOAM531wLD2A7C+XHvjRnnPfOBYnurDYakG9uKTsc/zKVf9fltg/E/o+ 0K20tl+B8ajlxIhGvf6TG5dDXPytywfdbw== X-Google-Smtp-Source: ABdhPJxanqE0pPa4iUEdwJDnjpchifABIk5MS751c1ejuOjKmwM5WdqWQUOBlaTwLtGQfNmlgKZpnA== X-Received: by 2002:a5d:618f:0:b0:20c:4cfc:8d72 with SMTP id j15-20020a5d618f000000b0020c4cfc8d72mr17453182wru.14.1652170872964; Tue, 10 May 2022 01:21:12 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id d13-20020a05600c34cd00b003942a244edcsm1817125wmq.33.2022.05.10.01.21.12 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 10 May 2022 01:21:12 -0700 (PDT) Date: Tue, 10 May 2022 08:21:12 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Incorrect ineffective use type clause warning Message-ID: <20220510082112.GA3029313@adacore.com> MIME-Version: 1.0 Content-Disposition: inline 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, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE 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: Justin Squirek Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch fixes an issue in the compiler whereby a use_type_clause incorrectly gets flagged as ineffective when the use of it comes after a generic package instantiation where the installation of private use clauses are required and one such clause references the same type. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch8.adb (Use_One_Type): Remove code in charge of setting Current_Use_Clause when Id is known to be redundant, and modify the printing of errors associated with redundant use type clauses so that line number gets included in more cases. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -10571,20 +10571,6 @@ package body Sem_Ch8 is -- even if it is redundant at the place of the instantiation. elsif Redundant_Use (Id) then - - -- We must avoid incorrectly setting the Current_Use_Clause when we - -- are working with a redundant clause that has already been linked - -- in the Prev_Use_Clause chain, otherwise the chain will break. - - if Present (Current_Use_Clause (T)) - and then Present (Prev_Use_Clause (Current_Use_Clause (T))) - and then Parent (Id) = Prev_Use_Clause (Current_Use_Clause (T)) - then - null; - else - Set_Current_Use_Clause (T, Parent (Id)); - end if; - Set_Used_Operations (Parent (Id), New_Elmt_List); -- If the subtype mark designates a subtype in a different package, @@ -10689,121 +10675,98 @@ package body Sem_Ch8 is -- Start of processing for Use_Clause_Known begin - -- If both current use_type_clause and the use_type_clause - -- for the type are at the compilation unit level, one of - -- the units must be an ancestor of the other, and the - -- warning belongs on the descendant. - - if Nkind (Parent (Clause1)) = N_Compilation_Unit - and then - Nkind (Parent (Clause2)) = N_Compilation_Unit - then - -- If the unit is a subprogram body that acts as spec, - -- the context clause is shared with the constructed - -- subprogram spec. Clearly there is no redundancy. - - if Clause1 = Clause2 then - return; - end if; + -- If the unit is a subprogram body that acts as spec, the + -- context clause is shared with the constructed subprogram + -- spec. Clearly there is no redundancy. - Unit1 := Unit (Parent (Clause1)); - Unit2 := Unit (Parent (Clause2)); + if Clause1 = Clause2 then + return; + end if; - -- If both clauses are on same unit, or one is the body - -- of the other, or one of them is in a subunit, report - -- redundancy on the later one. + Unit1 := Unit (Enclosing_Comp_Unit_Node (Clause1)); + Unit2 := Unit (Enclosing_Comp_Unit_Node (Clause2)); - if Unit1 = Unit2 or else Nkind (Unit1) = N_Subunit then - Error_Msg_Sloc := Sloc (Current_Use_Clause (T)); - Error_Msg_NE -- CODEFIX - ("& is already use-visible through previous " - & "use_type_clause #??", Clause1, T); - return; - - elsif Nkind (Unit2) in N_Package_Body | N_Subprogram_Body - and then Nkind (Unit1) /= Nkind (Unit2) - and then Nkind (Unit1) /= N_Subunit - then - Error_Msg_Sloc := Sloc (Clause1); - Error_Msg_NE -- CODEFIX - ("& is already use-visible through previous " - & "use_type_clause #??", Current_Use_Clause (T), T); - return; - end if; + -- If both clauses are on same unit, or one is the body of + -- the other, or one of them is in a subunit, report + -- redundancy on the later one. - -- There is a redundant use_type_clause in a child unit. - -- Determine which of the units is more deeply nested. - -- If a unit is a package instance, retrieve the entity - -- and its scope from the instance spec. + if Unit1 = Unit2 + or else Nkind (Unit1) = N_Subunit + or else + (Nkind (Unit2) in N_Package_Body | N_Subprogram_Body + and then Nkind (Unit1) /= Nkind (Unit2) + and then Nkind (Unit1) /= N_Subunit) + then + Error_Msg_Sloc := Sloc (Clause1); + Error_Msg_NE -- CODEFIX + ("& is already use-visible through previous " + & "use_type_clause #??", Clause2, T); + return; + end if; - Ent1 := Entity_Of_Unit (Unit1); - Ent2 := Entity_Of_Unit (Unit2); + -- There is a redundant use_type_clause in a child unit. + -- Determine which of the units is more deeply nested. If a + -- unit is a package instance, retrieve the entity and its + -- scope from the instance spec. - if Scope (Ent2) = Standard_Standard then - Error_Msg_Sloc := Sloc (Current_Use_Clause (T)); - Err_No := Clause1; + Ent1 := Entity_Of_Unit (Unit1); + Ent2 := Entity_Of_Unit (Unit2); - elsif Scope (Ent1) = Standard_Standard then - Error_Msg_Sloc := Sloc (Id); - Err_No := Clause2; + if Scope (Ent2) = Standard_Standard then + Error_Msg_Sloc := Sloc (Clause2); + Err_No := Clause1; - -- If both units are child units, we determine which one - -- is the descendant by the scope distance to the - -- ultimate parent unit. + elsif Scope (Ent1) = Standard_Standard then + Error_Msg_Sloc := Sloc (Id); + Err_No := Clause2; - else - declare - S1 : Entity_Id; - S2 : Entity_Id; - - begin - S1 := Scope (Ent1); - S2 := Scope (Ent2); - while Present (S1) - and then Present (S2) - and then S1 /= Standard_Standard - and then S2 /= Standard_Standard - loop - S1 := Scope (S1); - S2 := Scope (S2); - end loop; + -- If both units are child units, we determine which one is + -- the descendant by the scope distance to the ultimate + -- parent unit. - if S1 = Standard_Standard then - Error_Msg_Sloc := Sloc (Id); - Err_No := Clause2; - else - Error_Msg_Sloc := Sloc (Current_Use_Clause (T)); - Err_No := Clause1; - end if; - end; - end if; + else + declare + S1 : Entity_Id; + S2 : Entity_Id; - if Parent (Id) /= Err_No then - if Most_Descendant_Use_Clause - (Err_No, Parent (Id)) = Parent (Id) - then - Error_Msg_Sloc := Sloc (Err_No); - Err_No := Parent (Id); + begin + S1 := Scope (Ent1); + S2 := Scope (Ent2); + while Present (S1) + and then Present (S2) + and then S1 /= Standard_Standard + and then S2 /= Standard_Standard + loop + S1 := Scope (S1); + S2 := Scope (S2); + end loop; + + if S1 = Standard_Standard then + Error_Msg_Sloc := Sloc (Id); + Err_No := Clause2; + else + Error_Msg_Sloc := Sloc (Clause2); + Err_No := Clause1; end if; + end; + end if; - Error_Msg_NE -- CODEFIX - ("& is already use-visible through previous " - & "use_type_clause #??", Err_No, Id); + if Parent (Id) /= Err_No then + if Most_Descendant_Use_Clause + (Err_No, Parent (Id)) = Parent (Id) + then + Error_Msg_Sloc := Sloc (Err_No); + Err_No := Parent (Id); end if; - -- Case where current use_type_clause and use_type_clause - -- for the type are not both at the compilation unit level. - -- In this case we don't have location information. - - else Error_Msg_NE -- CODEFIX ("& is already use-visible through previous " - & "use_type_clause??", Id, T); + & "use_type_clause #??", Err_No, Id); end if; end Use_Clause_Known; - -- Here if Current_Use_Clause is not set for T, another case where - -- we do not have the location information available. + -- Here Current_Use_Clause is not set for T, so we do not have the + -- location information available. else Error_Msg_NE -- CODEFIX