* [COMMITTED] ada: Fix incorrect warning about unreferenced packed arrays
@ 2023-01-05 14:38 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-01-05 14:38 UTC (permalink / raw)
To: gcc-patches; +Cc: Bob Duff
From: Bob Duff <duff@adacore.com>
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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-01-05 14:38 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-01-05 14:38 [COMMITTED] ada: Fix incorrect warning about unreferenced packed arrays Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).