Skip to content

R
riscv-gcc-1
Commit 561b5849 by Robert Dewar Committed by Arnaud Charlet
Options

sem_ch5.adb, [...]: Update handling of assigned value/unreferenced warnings 

2007-12-06  Robert Dewar  <dewar@adacore.com>

	* sem_ch5.adb, s-taskin.adb, a-ciorma.adb, a-coorma.adb, a-cohama.adb, 
	a-cihama.adb, g-awk.adb, 
	s-inmaop-posix.adb: Update handling of assigned value/unreferenced
	warnings

	* exp_smem.adb: Update handling of assigned value/unreferenced warnings

	* sem.adb: Update handling of assigned value/unreferenced warnings

	* a-exexpr-gcc.adb: Add a pragma warnings off for boolean return

	* lib-xref.ads: Improve documentation for k xref type

	* lib-xref.adb: 
	Update handling of assigned value/unreferenced warnings
	(Generate_Reference): Warning for reference to entity for which a
	pragma Unreferenced has been given should be unconditional.
	If the entity is a discriminal, mark the original
	discriminant as referenced.

	* sem_warn.ads, sem_warn.adb
	(Check_One_Unit): Test Renamed_In_Spec to control giving warning for
	no entities referenced in package
	(Check_One_Unit): Don't give message about no entities referenced in
	a package if a pragma Unreferenced has appeared.
	Handle new warning flag -gnatw.a/-gnatw.A
	Update handling of assigned value/unreferenced warnings

	* atree.h: Add flags up to Flag247
	(Flag231): New macro.

From-SVN: r130815
parent 0312b364
Showing with 203 additions and 99 deletions
gcc/ada/a-cihama.adb
......@@ -967,9 +967,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
declare
K : Key_Type renames Position.Node.Key.all;
E : Element_Type renames Position.Node.Element.all;
pragma Unreferenced (E);
begin
Process (K, E);
......
gcc/ada/a-ciorma.adb
......@@ -1302,9 +1302,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
declare
K : Key_Type renames Position.Node.Key.all;
E : Element_Type renames Position.Node.Element.all;
pragma Unreferenced (E);
begin
Process (K, E);
......
gcc/ada/a-cohama.adb
......@@ -852,9 +852,10 @@ package body Ada.Containers.Hashed_Maps is
declare
K : Key_Type renames Position.Node.Key;
E : Element_Type renames Position.Node.Element;
pragma Unreferenced (E);
begin
Process (K, E);
exception
when others =>
L := L - 1;
......
gcc/ada/a-coorma.adb
......@@ -1183,9 +1183,7 @@ package body Ada.Containers.Ordered_Maps is
declare
K : Key_Type renames Position.Node.Key;
E : Element_Type renames Position.Node.Element;
pragma Unreferenced (E);
begin
Process (K, E);
......
gcc/ada/a-exexpr-gcc.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -242,18 +242,19 @@ package body Exception_Propagation is
-- Copy all the components of Source to Target as well as the
-- Private_Data pointer.
------------------------------------------------------------
-- Accessors to basic components of a GNAT exception data --
------------------------------------------------------------
--------------------------------------------------------------------
-- Accessors to Basic Components of a GNAT Exception Data Pointer --
--------------------------------------------------------------------
-- As of today, these are only used by the C implementation of the
-- GCC propagation personality routine to avoid having to rely on a C
-- As of today, these are only used by the C implementation of the GCC
-- propagation personality routine to avoid having to rely on a C
-- counterpart of the whole exception_data structure, which is both
-- painful and error prone. These subprograms could be moved to a
-- more widely visible location if need be.
-- painful and error prone. These subprograms could be moved to a more
-- widely visible location if need be.
function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
pragma Warnings (Off, Is_Handled_By_Others);
function Language_For (E : Exception_Data_Ptr) return Character;
pragma Export (C, Language_For, "__gnat_language_for");
......
gcc/ada/atree.h
......@@ -726,6 +726,7 @@ extern Node_Id Current_Error_Node;
#define Flag213(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag213)
#define Flag214(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag214)
#define Flag215(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag215)
#define Flag216(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag216)
#define Flag217(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag217)
#define Flag218(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag218)
......@@ -741,3 +742,20 @@ extern Node_Id Current_Error_Node;
#define Flag228(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag228)
#define Flag229(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag229)
#define Flag230(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag230)
#define Flag231(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag231)
#define Flag232(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag232)
#define Flag233(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag233)
#define Flag234(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag234)
#define Flag235(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag235)
#define Flag236(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag236)
#define Flag237(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag237)
#define Flag238(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag238)
#define Flag239(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag239)
#define Flag240(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag240)
#define Flag241(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag241)
#define Flag242(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag242)
#define Flag243(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag243)
#define Flag244(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag244)
#define Flag245(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag245)
#define Flag246(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag246)
#define Flag247(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag247)
gcc/ada/exp_smem.adb
......@@ -245,17 +245,25 @@ package body Exp_Smem is
-------------------
function Is_Out_Actual (N : Node_Id) return Boolean is
Kind : Entity_Kind;
Call : Node_Id;
Formal : Entity_Id;
Call : Node_Id;
begin
Find_Actual_Mode (N, Kind, Call);
Find_Actual (N, Formal, Call);
if Kind = E_Out_Parameter or else Kind = E_In_Out_Parameter then
Insert_Node := Call;
return True;
else
if No (Formal) then
return False;
else
if Ekind (Formal) = E_Out_Parameter
or else
Ekind (Formal) = E_In_Out_Parameter
then
Insert_Node := Call;
return True;
else
return False;
end if;
end if;
end Is_Out_Actual;
......
gcc/ada/g-awk.adb
......@@ -1475,7 +1475,6 @@ package body GNAT.AWK is
procedure Split_Line (Session : Session_Type) is
Fields : Field_Table.Instance renames Session.Data.Fields;
pragma Unreferenced (Fields);
begin
Field_Table.Init (Fields);
Split.Current_Line (Session.Data.Separators.all, Session);
......
gcc/ada/lib-xref.adb
......@@ -167,8 +167,8 @@ package body Lib.Xref is
if Sloc (Entity (N)) /= Standard_Location then
Generate_Reference (Entity (N), N);
-- A reference to an implicit inequality operator is a also a
-- reference to the user-defined equality.
-- A reference to an implicit inequality operator is also a reference
-- to the user-defined equality.
if Nkind (N) = N_Op_Ne
and then not Comes_From_Source (Entity (N))
......@@ -200,11 +200,11 @@ package body Lib.Xref is
------------------------
procedure Generate_Reference
(E : Entity_Id;
N : Node_Id;
Typ : Character := 'r';
Set_Ref : Boolean := True;
Force : Boolean := False)
(E : Entity_Id;
N : Node_Id;
Typ : Character := 'r';
Set_Ref : Boolean := True;
Force : Boolean := False)
is
Indx : Nat;
Nod : Node_Id;
......@@ -212,9 +212,12 @@ package body Lib.Xref is
Def : Source_Ptr;
Ent : Entity_Id;
Call : Node_Id;
Formal : Entity_Id;
-- Used for call to Find_Actual
Kind : Entity_Kind;
Call : Node_Id;
-- Arguments used in call to Find_Actual_Mode
-- If Formal is non-Empty, then its Ekind, otherwise E_Void
function Is_On_LHS (Node : Node_Id) return Boolean;
-- Used to check if a node is on the left hand side of an assignment.
......@@ -256,7 +259,7 @@ package body Lib.Xref is
return False;
end if;
-- Immediat return if appeared as OUT parameter
-- Immediate return if appeared as OUT parameter
if Kind = E_Out_Parameter then
return True;
......@@ -311,7 +314,13 @@ package body Lib.Xref is
begin
pragma Assert (Nkind (E) in N_Entity);
Find_Actual_Mode (N, Kind, Call);
Find_Actual (N, Formal, Call);
if Present (Formal) then
Kind := Ekind (Formal);
else
Kind := E_Void;
end if;
-- Check for obsolescent reference to package ASCII. GNAT treats this
-- element of annex J specially since in practice, programs make a lot
......@@ -407,25 +416,45 @@ package body Lib.Xref is
if Set_Ref then
-- For a variable that appears on the left side of an assignment
-- statement, we set the Referenced_As_LHS flag since this is indeed
-- a left hand side. We also set the Referenced_As_LHS flag of a
-- prefix of selected or indexed component.
-- Assignable object appearing on left side of assignment or as
-- an out parameter.
if (Ekind (E) = E_Variable or else Is_Formal (E))
if Is_Assignable (E)
and then Is_On_LHS (N)
and then Ekind (E) /= E_In_Out_Parameter
then
-- If we have the OUT parameter case and the warning mode for
-- OUT parameters is not set, treat this as an ordinary reference
-- since we don't want warnings about it being unset.
-- For objects that are renamings, just set as simply referenced
-- we do not try to do assignment type tracking in this case.
if Kind = E_Out_Parameter and not Warn_On_Out_Parameter_Unread then
if Present (Renamed_Object (E)) then
Set_Referenced (E);
-- For other cases, set referenced on LHS
-- Out parameter case
elsif Kind = E_Out_Parameter then
-- If warning mode for all out parameters is set, or this is
-- the only warning parameter, then we want to mark this for
-- later warning logic by setting Referenced_As_Out_Parameter
if Warn_On_Modified_As_Out_Parameter (Formal) then
Set_Referenced_As_Out_Parameter (E, True);
Set_Referenced_As_LHS (E, False);
-- For OUT parameter not covered by the above cases, we simply
-- regard it as a normal reference (in this case we do not
-- want any of the warning machinery for out parameters).
else
Set_Referenced (E);
end if;
-- For the left hand of an assignment case, we do nothing here.
-- The processing for Analyze_Assignment_Statement will set the
-- Referenced_As_LHS flag.
else
Set_Referenced_As_LHS (E);
null;
end if;
-- Check for a reference in a pragma that should not count as a
......@@ -469,33 +498,33 @@ package body Lib.Xref is
-- All other cases
else
-- Special processing for IN OUT and OUT parameters, where we
-- have an implicit assignment to a simple variable.
-- Special processing for IN OUT parameters, where we have an
-- implicit assignment to a simple variable.
if (Kind = E_Out_Parameter or else Kind = E_In_Out_Parameter)
and then Is_Entity_Name (N)
and then Present (Entity (N))
and then Is_Assignable (Entity (N))
if Kind = E_In_Out_Parameter
and then Is_Assignable (E)
then
-- Record implicit assignment unless we have an intrinsic
-- subprogram, which is most likely an instantiation of
-- Unchecked_Deallocation which we do not want to consider
-- as an assignment since it generates false positives. We
-- also exclude the case of an IN OUT parameter to a procedure
-- called Free, since we suspect similar semantics.
if Is_Entity_Name (Name (Call))
-- For sure this counts as a normal read reference
Set_Referenced (E);
Set_Last_Assignment (E, Empty);
-- We count it as being referenced as an out parameter if the
-- option is set to warn on all out parameters, except that we
-- have a special exclusion for an intrinsic subprogram, which
-- is most likely an instantiation of Unchecked_Deallocation
-- which we do not want to consider as an assignment since it
-- generates false positives. We also exclude the case of an
-- IN OUT parameter if the name of the procedure is Free,
-- since we suspect similar semantics.
if Warn_On_All_Unread_Out_Parameters
and then Is_Entity_Name (Name (Call))
and then not Is_Intrinsic_Subprogram (Entity (Name (Call)))
and then (Kind /= E_In_Out_Parameter
or else Chars (Name (Call)) /= Name_Free)
and then Chars (Name (Call)) /= Name_Free
then
Set_Referenced_As_LHS (E);
end if;
-- For IN OUT case, treat as also being normal reference
if Kind = E_In_Out_Parameter then
Set_Referenced (E);
Set_Referenced_As_Out_Parameter (E, True);
Set_Referenced_As_LHS (E, False);
end if;
-- Any other occurrence counts as referencing the entity
......@@ -549,7 +578,7 @@ package body Lib.Xref is
while Present (BE) loop
if Chars (BE) = Chars (E) then
Error_Msg_NE
("?pragma Unreferenced given for&", N, BE);
("?pragma Unreferenced given for&!", N, BE);
exit;
end if;
......@@ -560,7 +589,7 @@ package body Lib.Xref is
-- Here we issue the warning, since this is a real reference
else
Error_Msg_NE ("?pragma Unreferenced given for&", N, E);
Error_Msg_NE ("?pragma Unreferenced given for&!", N, E);
end if;
end if;
......@@ -664,6 +693,15 @@ package body Lib.Xref is
then
Ent := Original_Record_Component (E);
-- If this is an expanded reference to a discriminant, recover the
-- original discriminant, which gets the reference.
elsif Ekind (E) = E_In_Parameter
and then Present (Discriminal_Link (E))
then
Ent := Discriminal_Link (E);
Set_Referenced (Ent);
-- Ignore reference to any other entity that is not from source
else
......@@ -1424,11 +1462,13 @@ package body Lib.Xref is
(Int (Get_Logical_Line_Number (Sloc (Tref))));
declare
Ent : Entity_Id := Tref;
Kind : constant Entity_Kind := Ekind (Ent);
Ctyp : Character := Xref_Entity_Letters (Kind);
Ent : Entity_Id;
Ctyp : Character;
begin
Ent := Tref;
Ctyp := Xref_Entity_Letters (Ekind (Ent));
if Ctyp = '+'
and then Present (Full_View (Ent))
then
......
gcc/ada/lib-xref.ads
......@@ -237,8 +237,33 @@ package Lib.Xref is
-- source node that generates the implicit reference, and it is
-- useful to record this one.
-- k is used to denote a reference to the parent unit, in the
-- cross-reference line for a child unit.
-- k is another non-standard reference type, used to record a
-- reference from a child unit to its parent. For various cross-
-- referencing tools, we need a pointer from the xref entries for
-- the child to the parent. This is the opposite way round from
-- normal xref entries, since the reference is *from* the child
-- unit *to* the parent unit, yet appears in the xref entries for
-- the child. Consider this example:
--
-- package q is
-- end;
-- package q.r is
-- end q.r;
--
-- The ali file for q-r.ads has these entries
--
-- D q.ads
-- D q-r.ads
-- D system.ads
-- X 1 q.ads
-- 1K9*q 2e4 2|1r9 2r5
-- X 2 q-r.ads
-- 1K11*r 1|1k9 2|2l7 2e8
--
-- Here the 2|1r9 entry appearing in the section for the parent
-- is the normal reference from the child to the parent. The 1k9
-- entry in the section for the child duplicates this information
-- but appears in the child rather than the parent.
-- l is used to identify the occurrence in the source of the
-- name on an end line. This is just a syntactic reference
......@@ -568,11 +593,11 @@ package Lib.Xref is
-- a renaming of a predefined operator.
procedure Generate_Reference
(E : Entity_Id;
N : Node_Id;
Typ : Character := 'r';
Set_Ref : Boolean := True;
Force : Boolean := False);
(E : Entity_Id;
N : Node_Id;
Typ : Character := 'r';
Set_Ref : Boolean := True;
Force : Boolean := False);
-- This procedure is called to record a reference. N is the location
-- of the reference and E is the referenced entity. Typ is one of:
--
......
gcc/ada/s-inmaop-posix.adb
......@@ -60,8 +60,9 @@ package body System.Interrupt_Management.Operations is
Initial_Action : array (Signal) of aliased struct_sigaction;
Default_Action : aliased struct_sigaction;
pragma Warnings (Off, Default_Action);
Ignore_Action : aliased struct_sigaction;
Ignore_Action : aliased struct_sigaction;
----------------------------
-- Thread_Block_Interrupt --
......@@ -136,11 +137,11 @@ package body System.Interrupt_Management.Operations is
--------------------
function Interrupt_Wait
(Mask : access Interrupt_Mask)
return Interrupt_ID
(Mask : access Interrupt_Mask) return Interrupt_ID
is
Result : Interfaces.C.int;
Sig : aliased Signal;
begin
Result := sigwait (Mask, Sig'Access);
......
gcc/ada/s-taskin.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -160,9 +160,11 @@ package body System.Tasking is
procedure Initialize is
T : Task_Id;
Success : Boolean;
Base_Priority : Any_Priority;
Success : Boolean;
pragma Warnings (Off, Success);
begin
if Initialized then
return;
......
gcc/ada/sem.adb
......@@ -727,6 +727,7 @@ package body Sem is
To : Entity_Id)
is
Found : Boolean;
pragma Warnings (Off, Found);
procedure Search_Stack
(Top : Suppress_Stack_Entry_Ptr;
......@@ -1282,10 +1283,10 @@ package body Sem is
S_Sem_Unit : constant Unit_Number_Type := Current_Sem_Unit;
S_GNAT_Mode : constant Boolean := GNAT_Mode;
S_Discard_Names : constant Boolean := Global_Discard_Names;
Generic_Main : constant Boolean :=
Nkind (Unit (Cunit (Main_Unit)))
in N_Generic_Declaration;
Generic_Main : constant Boolean :=
Nkind (Unit (Cunit (Main_Unit)))
in N_Generic_Declaration;
-- If the main unit is generic, every compiled unit, including its
-- context, is compiled with expansion disabled.
......
gcc/ada/sem_ch5.adb
......@@ -220,9 +220,7 @@ package body Sem_Ch5 is
-- If assignment operand is a component reference, then we get the
-- actual subtype of the component for the unconstrained case.
elsif
(Nkind (Opnd) = N_Selected_Component
or else Nkind (Opnd) = N_Explicit_Dereference)
elsif Nkind_In (Opnd, N_Selected_Component, N_Explicit_Dereference)
and then not Is_Unchecked_Union (Opnd_Type)
then
Decl := Build_Actual_Subtype_Of_Component (Opnd_Type, Opnd);
......@@ -685,6 +683,17 @@ package body Sem_Ch5 is
Check_Elab_Assign (Lhs);
end if;
-- 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.
if Comes_From_Source (N)
and then In_Extended_Main_Source_Unit (Lhs)
then
Set_Referenced_Modified (Lhs, Out_Param => False);
end if;
-- Final step. If left side is an entity, then we may be able to
-- reset the current tracked values to new safe values. We only have
-- something to do if the left side is an entity name, and expansion
......@@ -715,7 +724,7 @@ package body Sem_Ch5 is
and then Comes_From_Source (N)
and then In_Extended_Main_Source_Unit (Ent)
then
Warn_On_Useless_Assignment (Ent, Sloc (N));
Warn_On_Useless_Assignment (Ent, N);
Set_Last_Assignment (Ent, Lhs);
end if;
......@@ -1458,8 +1467,8 @@ package body Sem_Ch5 is
if Analyzed (Original_Bound) then
return Original_Bound;
elsif Nkind (Analyzed_Bound) = N_Integer_Literal
or else Nkind (Analyzed_Bound) = N_Character_Literal
elsif Nkind_In (Analyzed_Bound, N_Integer_Literal,
N_Character_Literal)
or else Is_Entity_Name (Analyzed_Bound)
then
Analyze_And_Resolve (Original_Bound, Typ);
......
gcc/ada/sem_warn.ads
......@@ -157,6 +157,11 @@ package Sem_Warn is
-- If all these conditions are met, the warning is issued noting that
-- the result of the test is always false or always true as appropriate.
function Warn_On_Modified_As_Out_Parameter (E : Entity_Id) return Boolean;
-- Returns True if we should activate warnings for entity E being modified
-- as an out parameter. True if either Warn_On_Modified_Unread is set for
-- an only OUT parameter, or if Warn_On_All_Unread_Out_Parameters is set.
procedure Warn_On_Suspicious_Index (Name : Entity_Id; X : Node_Id);
-- This is called after resolving an indexed component or a slice. Name
-- is the entity for the name of the indexed array, and X is the subscript
......@@ -176,14 +181,14 @@ package Sem_Warn is
procedure Warn_On_Useless_Assignment
(Ent : Entity_Id;
Loc : Source_Ptr := No_Location);
N : Node_Id := Empty);
-- Called to check if we have a case of a useless assignment to the given
-- entity Ent, as indicated by a non-empty Last_Assignment field. This call
-- should only be made if at least one of the flags Warn_On_Modified_Unread
-- or Warn_On_Out_Parameter_Unread is True, and if Ent is in the extended
-- main source unit. Loc is No_Location for the end of block call (warning
-- message says value unreferenced), or the it is the location of an
-- overwriting assignment (warning message points to this assignment).
-- or Warn_On_All_Unread_Out_Parameters is True, and if Ent is in the
-- extended main source unit. N is Empty for the end of block call
-- (warning message says value unreferenced), or the it is the node for
-- an overwriting assignment (warning message points to this assignment).
procedure Warn_On_Useless_Assignments (E : Entity_Id);
pragma Inline (Warn_On_Useless_Assignments);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment