From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x329.google.com (mail-wm1-x329.google.com [IPv6:2a00:1450:4864:20::329]) by sourceware.org (Postfix) with ESMTPS id 21B9F3858C39 for ; Thu, 5 Jan 2023 14:38:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 21B9F3858C39 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wm1-x329.google.com with SMTP id l26so26575226wme.5 for ; Thu, 05 Jan 2023 06:38:41 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=DW+1tw4ougViulyGy/RQ34idGYigEcuocT9vMGdBh8M=; b=cO0khp93t84m+Ls9suOrPX0LAn0D2teS3CdleTwNxZihoZJtGE9z5ez5CzNT23IuJW KWNuSU/mRD/dRdNvrLYjIpuNagfB6hUccVFYwh/jqkXHZLIWbbdKInTQO7DF4VO6o5Nf o7jY1wFlL3Y3PcfPyiiBJM7eYvliUzfoyaQuTkm50mKHS6f+Dy1Tr7zf97OvGTrOXbGM pb2+CvmjIYXJtFpxTnvollFX5o0wVD/9D2pLHqCczc/JSkfCPvg+gw4Q7Lq1xN4cMfF7 w17De4h+GdGkp364Lm+GiB+MeT9TNPA82EGF+LDpCNa+PQI1fw9nN3+AJuQk3ftz5h1H EvsQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; 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=DW+1tw4ougViulyGy/RQ34idGYigEcuocT9vMGdBh8M=; b=a/ZWX1A77GgB4gLL3D8WbnNOB4qeTKlqoj2lJJETDAyvgYsy6gZ7AlQyrdywynWd3T uxtiypNdNwHlTEfO/CEK8WXL4d6cOZv26Or1AfcQQRdXw7gnVPKrZRd35g1sSNSMKLAU XttHVCKuELiKanGFo93w++jKsYA0VuPa21HEhRGGWEJGIWRzJUJWN7U0e5DGLVRJ3rHe ubqLXjMkAw6C60D/f+sgt7rmt0UQD2SJa7Fyp0i/Qg+Czg7KYZXMm56F/ZUtn7AeRebB PYtcLA4nICPNO0qgsrQEUKKD+RuxhjBSWFbizue82IfYWV3TLKK/YH6oa1sIJbNXxb4S i11Q== X-Gm-Message-State: AFqh2ko2jA5yLXXYdWq5SWcSQ0msC69gflRl2I/1YJdmSVB3fiVbJa8l SAaQ4UAgdLTeOjaxXVV/XMTSkd2hunU1niDDzx8= X-Google-Smtp-Source: AMrXdXu3ZiylVZkhDSJy3M13s8zpE9p9qI3gb1yXVIv7Qga2e5enuySR3EzTJE8q7qHCSfS9HTRjlA== X-Received: by 2002:a05:600c:1c85:b0:3d3:4b18:27c6 with SMTP id k5-20020a05600c1c8500b003d34b1827c6mr35804536wms.11.1672929519893; Thu, 05 Jan 2023 06:38:39 -0800 (PST) Received: from poulhies-Precision-5550.lan (static-176-191-105-132.ftth.abo.bbox.fr. [176.191.105.132]) by smtp.gmail.com with ESMTPSA id t5-20020a5d49c5000000b0028cf987d944sm19757511wrs.33.2023.01.05.06.38.38 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 05 Jan 2023 06:38:39 -0800 (PST) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [COMMITTED] ada: Fix incorrect warning about unreferenced packed arrays Date: Thu, 5 Jan 2023 15:38:35 +0100 Message-Id: <20230105143835.155238-1-poulhies@adacore.com> X-Mailer: git-send-email 2.34.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit 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 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: Bob Duff This patch fixes a bug in which a reference to a renaming of a component of a packed array was not counted as a reference, and thus caused incorrect warnings about unreferenced objects. gcc/ada/ * sem_ch5.adb (Analyze_Assignment): Fix the bug by checking Original_Node. The renaming might be elsewhere, but the (original) reference is right here. * errout.adb: Remove pragma Unreferenced which was added because of the above bug. * einfo.ads: Misc cleanup. * lib.adb: Likewise. * lib.ads: Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo.ads | 6 +-- gcc/ada/errout.adb | 2 +- gcc/ada/lib.adb | 96 ++++++++++++--------------------------------- gcc/ada/lib.ads | 9 ++--- gcc/ada/sem_ch5.adb | 13 +++--- 5 files changed, 41 insertions(+), 85 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d71dcaf8969..94022e7c635 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1865,7 +1865,7 @@ package Einfo is -- Has_Per_Object_Constraint -- Defined in E_Component entities. Set if the subtype of the component -- has a per object constraint. Per object constraints result from the --- following situations : +-- following situations: -- -- 1. N_Attribute_Reference - when the prefix is the enclosing type and -- the attribute is Access. @@ -4136,14 +4136,14 @@ package Einfo is -- set instead, or a similar appearance as an out parameter actual, in -- which case Referenced_As_Out_Parameter is set. --- Referenced_As_LHS : +-- Referenced_As_LHS -- Defined in all entities. This flag is set instead of Referenced if a -- simple variable that is not a renaming appears as the left side of an -- assignment. The reason we distinguish this kind of reference is that -- we have a separate warning for variables that are only assigned and -- never read. --- Referenced_As_Out_Parameter : +-- Referenced_As_Out_Parameter -- Defined in all entities. This flag is set instead of Referenced if a -- simple variable that is not a renaming appears as an actual for an out -- formal. The reason we distinguish this kind of reference is that diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 261ba2e8033..151096607c6 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -53,7 +53,7 @@ with Stand; use Stand; with Stylesw; use Stylesw; with System.OS_Lib; with Uname; use Uname; -with Warnsw; pragma Unreferenced (Warnsw); -- disable spurious warning +with Warnsw; package body Errout is diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 691d8e4acb9..68ae46a3584 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -320,15 +320,13 @@ package body Lib is begin if S1 = No_Location or else S2 = No_Location then return No; + end if; - elsif S1 = Standard_Location then - if S2 = Standard_Location then - return Yes_Same; - else - return No; - end if; + if S1 = S2 then + return Yes_Same; + end if; - elsif S2 = Standard_Location then + if S1 = Standard_Location or else S2 = Standard_Location then return No; end if; @@ -841,53 +839,36 @@ package body Lib is (N : Node_Or_Entity_Id) return Boolean is begin - if Sloc (N) = Standard_Location then - return False; - - elsif Sloc (N) = No_Location then - return False; - -- Special case Itypes to test the Sloc of the associated node. The -- reason we do this is for possible calls from gigi after -gnatD -- processing is complete in sprint. This processing updates the -- sloc fields of all nodes in the tree, but itypes are not in the -- tree so their slocs do not get updated. - elsif Nkind (N) = N_Defining_Identifier - and then Is_Itype (N) - then + if Nkind (N) = N_Defining_Identifier and then Is_Itype (N) then return In_Extended_Main_Code_Unit (Associated_Node_For_Itype (N)); - - -- Otherwise see if we are in the main unit - - elsif Get_Code_Unit (Sloc (N)) = Get_Code_Unit (Cunit (Main_Unit)) then - return True; - - -- Node may be in spec (or subunit etc) of main unit - - else - return In_Same_Extended_Unit (N, Cunit (Main_Unit)); end if; + + return In_Extended_Main_Code_Unit (Sloc (N)); end In_Extended_Main_Code_Unit; function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean is begin - if Loc = Standard_Location then - return False; + -- Special value cases - elsif Loc = No_Location then + if Loc in No_Location | Standard_Location then return False; + end if; -- Otherwise see if we are in the main unit - elsif Get_Code_Unit (Loc) = Get_Code_Unit (Cunit (Main_Unit)) then + if Get_Code_Unit (Loc) = Get_Code_Unit (Cunit (Main_Unit)) then return True; + end if; -- Location may be in spec (or subunit etc) of main unit - else - return In_Same_Extended_Unit (Loc, Sloc (Cunit (Main_Unit))); - end if; + return In_Same_Extended_Unit (Loc, Sloc (Cunit (Main_Unit))); end In_Extended_Main_Code_Unit; ---------------------------------- @@ -897,69 +878,42 @@ package body Lib is function In_Extended_Main_Source_Unit (N : Node_Or_Entity_Id) return Boolean is - Nloc : constant Source_Ptr := Sloc (N); - Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit)); - begin - -- If parsing, then use the global flag to indicate result - - if Compiler_State = Parsing then - return Parsing_Main_Extended_Source; - - -- Special value cases - - elsif Nloc = Standard_Location then - return False; - - elsif Nloc = No_Location then - return False; - -- Special case Itypes to test the Sloc of the associated node. The -- reason we do this is for possible calls from gigi after -gnatD -- processing is complete in sprint. This processing updates the -- sloc fields of all nodes in the tree, but itypes are not in the -- tree so their slocs do not get updated. - elsif Nkind (N) = N_Defining_Identifier - and then Is_Itype (N) - then + if Nkind (N) = N_Defining_Identifier and then Is_Itype (N) then + pragma Assert (Compiler_State /= Parsing); return In_Extended_Main_Source_Unit (Associated_Node_For_Itype (N)); - - -- Otherwise compare original locations to see if in same unit - - else - return - In_Same_Extended_Unit - (Original_Location (Nloc), Original_Location (Mloc)); end if; + + return In_Extended_Main_Source_Unit (Sloc (N)); end In_Extended_Main_Source_Unit; function In_Extended_Main_Source_Unit (Loc : Source_Ptr) return Boolean is - Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit)); - begin -- If parsing, then use the global flag to indicate result if Compiler_State = Parsing then return Parsing_Main_Extended_Source; + end if; -- Special value cases - elsif Loc = Standard_Location then - return False; - - elsif Loc = No_Location then + if Loc in No_Location | Standard_Location then return False; + end if; - -- Otherwise compare original locations to see if in same unit + -- Otherwise compare original locations - else - return - In_Same_Extended_Unit - (Original_Location (Loc), Original_Location (Mloc)); - end if; + return In_Same_Extended_Unit + (Original_Location (Loc), + Original_Location (Sloc (Cunit (Main_Unit)))); end In_Extended_Main_Source_Unit; ---------------------- diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index c308ac17ed8..6937eedc9a9 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -46,7 +46,7 @@ package Lib is Parsing_Main_Extended_Source : Boolean := False; -- Set True if we are currently parsing a file that is part of the main -- extended source (the main unit, its spec, or one of its subunits). This - -- flag to implement In_Extended_Main_Source_Unit. + -- is used to implement In_Extended_Main_Source_Unit. Analysing_Subunit_Of_Main : Boolean := False; -- Set to True when analyzing a subunit of the main source. When True, if @@ -616,8 +616,7 @@ package Lib is -- WARNING: There is a matching C declaration of this subprogram in fe.h function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean; - -- Same function as above, but argument is a source pointer rather - -- than a node. + -- Same as above, but for Source_Ptr function In_Extended_Main_Source_Unit (N : Node_Or_Entity_Id) return Boolean; @@ -631,7 +630,7 @@ package Lib is -- and the parent unit spec if it is separate. function In_Extended_Main_Source_Unit (Loc : Source_Ptr) return Boolean; - -- Same function as above, but argument is a source pointer + -- Same as above, but for Source_Ptr function ipu (N : Node_Or_Entity_Id) return Boolean; -- Same as In_Predefined_Unit, but renamed so it can assist debugging. @@ -646,7 +645,7 @@ package Lib is function In_Predefined_Unit (S : Source_Ptr) return Boolean; pragma Inline (In_Predefined_Unit); - -- Same function as above but argument is a source pointer + -- Same as above, but for Source_Ptr function In_Internal_Unit (N : Node_Or_Entity_Id) return Boolean; function In_Internal_Unit (S : Source_Ptr) return Boolean; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 344b3ebfdb2..a8834b8f6a0 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1154,13 +1154,16 @@ package body Sem_Ch5 is Record_Elaboration_Scenario (N); - -- Set Referenced_As_LHS if appropriate. We only set this flag if the - -- assignment is a source assignment in the extended main source unit. - -- We are not interested in any reference information outside this - -- context, or in compiler generated assignment statements. + -- Set Referenced_As_LHS if appropriate. We are not interested in + -- compiler-generated assignment statements, nor in references outside + -- the extended main source unit. We check whether the Original_Node is + -- in the extended main source unit because in the case of a renaming of + -- a component of a packed array, the Lhs itself has a Sloc from the + -- place of the renaming. if Comes_From_Source (N) - and then In_Extended_Main_Source_Unit (Lhs) + and then (In_Extended_Main_Source_Unit (Lhs) + or else In_Extended_Main_Source_Unit (Original_Node (Lhs))) then Set_Referenced_Modified (Lhs, Out_Param => False); end if; -- 2.34.1