declare
K : Key_Type renames Position.Node.Key.all;
-
E : Element_Type renames Position.Node.Element.all;
- pragma Unreferenced (E);
begin
Process (K, E);
declare
K : Key_Type renames Position.Node.Key.all;
-
E : Element_Type renames Position.Node.Element.all;
- pragma Unreferenced (E);
begin
Process (K, E);
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;
declare
K : Key_Type renames Position.Node.Key;
-
E : Element_Type renames Position.Node.Element;
- pragma Unreferenced (E);
begin
Process (K, E);
-- --
-- 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- --
-- 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");
#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)
#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)
-------------------
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;
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);
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))
------------------------
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;
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.
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;
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
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
-- 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
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;
-- 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;
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
(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
-- 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
-- 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:
--
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 --
--------------------
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);
-- --
-- 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- --
procedure Initialize is
T : Task_Id;
- Success : Boolean;
Base_Priority : Any_Priority;
+ Success : Boolean;
+ pragma Warnings (Off, Success);
+
begin
if Initialized then
return;
To : Entity_Id)
is
Found : Boolean;
+ pragma Warnings (Off, Found);
procedure Search_Stack
(Top : Suppress_Stack_Entry_Ptr;
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.
-- 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);
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
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;
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);
-- formal, the setting of the flag in the corresponding spec is also
-- checked (and True returned if either flag is True).
+ function Referenced_As_Out_Parameter_Check_Spec
+ (E : Entity_Id) return Boolean;
+ -- Tests Referenced_As_Out_Parameter status for entity E. If E is not a
+ -- formal, this is simply the setting of Referenced_As_Out_Parameter. If E
+ -- is a body formal, the setting of the flag in the corresponding spec is
+ -- also checked (and True returned if either flag is True).
+
procedure Warn_On_Unreferenced_Entity
(Spec_E : Entity_Id;
Body_E : Entity_Id := Empty);
Ref := N;
Var := Entity (Ref);
- -- Case of condition is a comparison with compile time known value
+ -- Case of condition is a comparison with compile time known value
elsif Nkind (N) in N_Op_Compare then
if Compile_Time_Known_Value (Right_Opnd (N)) then
return;
end if;
- -- If condition is a negation, check its operand
+ -- If condition is a negation, check its operand
elsif Nkind (N) = N_Op_Not then
Find_Var (Right_Opnd (N));
- -- Case of condition is function call
+ -- Case of condition is function call
elsif Nkind (N) = N_Function_Call then
if not Is_Entity_Name (Name (N)) then
return;
- -- Forget it if warnings are suppressed on function entity
+ -- Forget it if warnings are suppressed on function entity
elsif Warnings_Off (Entity (Name (N))) then
return;
Find_Var (First (PA));
end if;
- -- Not one argument
+ -- Not one argument
else
return;
end if;
end;
- -- Any other kind of node is not something we warn for
+ -- Any other kind of node is not something we warn for
else
return;
return False;
end Substring_Present;
- -- Start of processing for Is_Suspicious_Function_Name
+ -- Start of processing for Is_Suspicious_Function_Name
begin
S := E;
if N = Iter then
return Skip;
- -- Direct reference to variable in question
+ -- Direct reference to variable in question
elsif Is_Entity_Name (N)
and then Present (Entity (N))
declare
P : Node_Id;
+
begin
P := N;
loop
("?variable& is never read and never assigned!");
end if;
- -- Deal with special case where this variable is
- -- hidden by a loop variable
+ -- Deal with special case where this variable is hidden
+ -- by a loop variable.
if Ekind (E1) = E_Variable
and then Present (Hiding_Loop_Variable (E1))
-- Check that warnings on unreferenced entities are enabled
- and then ((Check_Unreferenced and then not Is_Formal (E1))
- or else
- (Check_Unreferenced_Formals and then Is_Formal (E1))
- or else
- ((Warn_On_Modified_Unread
- or Warn_On_Out_Parameter_Unread)
- and then Referenced_As_LHS_Check_Spec (E1)))
+ and then
+ ((Check_Unreferenced and then not Is_Formal (E1))
+
+ -- Case of warning on unreferenced formal
+
+ or else
+ (Check_Unreferenced_Formals and then Is_Formal (E1))
+
+ -- Case of warning on unread variables modified by an
+ -- assignment, or an out parameter if it is the only one.
+
+ or else
+ (Warn_On_Modified_Unread
+ and then Referenced_As_LHS_Check_Spec (E1))
+
+ -- Case of warning on any unread out parameter (note
+ -- such indications are only set if the appropriate
+ -- warning options were set, so no need to recheck here.
+
+ or else
+ Referenced_As_Out_Parameter_Check_Spec (E1))
-- Labels, and enumeration literals, and exceptions. The
-- warnings are also placed on local packages that cannot be
-- are referenced. If none of the entities are referenced, we
-- still post a warning. This occurs if the only use of the
-- package is in a use clause, or in a package renaming
- -- declaration.
-
- elsif Ekind (Lunit) = E_Package then
+ -- declaration. This check is skipped for packages that are
+ -- renamed in a spec, since the entities in such a package are
+ -- visible to clients via the renaming.
+ elsif Ekind (Lunit) = E_Package
+ and then not Renamed_In_Spec (Lunit)
+ then
-- If Is_Instantiated is set, it means that the package is
-- implicitly instantiated (this is the case of parent
-- instance or an actual for a generic package formal), and
-- Else give the warning
else
- Error_Msg_N
- ("?no entities of & are referenced!",
- Name (Item));
+ if not Has_Pragma_Unreferenced
+ (Entity (Name (Item)))
+ then
+ Error_Msg_N
+ ("?no entities of & are referenced!",
+ Name (Item));
+ end if;
-- Look for renamings of this package, and flag
-- them as well. If the original package has
if Present (Pack)
and then not Warnings_Off (Lunit)
+ and then not Has_Pragma_Unreferenced (Pack)
then
Error_Msg_NE
("?no entities of & are referenced!",
Unit_Declaration_Node (Pack),
- Pack);
+ Pack);
end if;
end if;
elsif Referenced_Check_Spec (Ent)
or else Referenced_As_LHS_Check_Spec (Ent)
+ or else Referenced_As_Out_Parameter_Check_Spec (Ent)
or else
(From_With_Type (Ent)
and then Is_Incomplete_Type (Ent)
Next (Item);
end loop;
-
end Check_One_Unit;
-- Start of processing for Check_Unused_Withs
end if;
end Referenced_As_LHS_Check_Spec;
+ --------------------------------------------
+ -- Referenced_As_Out_Parameter_Check_Spec --
+ --------------------------------------------
+
+ function Referenced_As_Out_Parameter_Check_Spec
+ (E : Entity_Id) return Boolean
+ is
+ begin
+ if Is_Formal (E) and then Present (Spec_Entity (E)) then
+ return Referenced_As_Out_Parameter (E)
+ or else Referenced_As_Out_Parameter (Spec_Entity (E));
+ else
+ return Referenced_As_Out_Parameter (E);
+ end if;
+ end Referenced_As_Out_Parameter_Check_Spec;
+
----------------------------
-- Set_Dot_Warning_Switch --
----------------------------
function Set_Dot_Warning_Switch (C : Character) return Boolean is
begin
case C is
+ when 'a' =>
+ Warn_On_Assertion_Failure := True;
+
+ when 'A' =>
+ Warn_On_Assertion_Failure := False;
+
when 'c' =>
Warn_On_Unrepped_Components := True;
Warn_On_Unrepped_Components := False;
when 'o' =>
- Warn_On_Out_Parameter_Unread := True;
+ Warn_On_All_Unread_Out_Parameters := True;
when 'O' =>
- Warn_On_Out_Parameter_Unread := False;
+ Warn_On_All_Unread_Out_Parameters := False;
when 'r' =>
Warn_On_Object_Renames_Function := True;
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
Warn_On_Ada_2005_Compatibility := True;
+ Warn_On_Assertion_Failure := True;
Warn_On_Assumed_Low_Bound := True;
Warn_On_Bad_Fixed_Value := True;
Warn_On_Constant := True;
Implementation_Unit_Warnings := False;
Ineffective_Inline_Warnings := False;
Warn_On_Ada_2005_Compatibility := False;
+ Warn_On_Assertion_Failure := False;
+ Warn_On_Assumed_Low_Bound := False;
Warn_On_Bad_Fixed_Value := False;
Warn_On_Constant := False;
Warn_On_Deleted_Code := False;
Warn_On_No_Value_Assigned := False;
Warn_On_Non_Local_Exception := False;
Warn_On_Obsolescent_Feature := False;
- Warn_On_Out_Parameter_Unread := False;
+ Warn_On_All_Unread_Out_Parameters := False;
Warn_On_Questionable_Missing_Parens := False;
Warn_On_Redundant_Constructs := False;
Warn_On_Object_Renames_Function := False;
end if;
end Warn_On_Known_Condition;
+ ---------------------------------------
+ -- Warn_On_Modified_As_Out_Parameter --
+ ---------------------------------------
+
+ function Warn_On_Modified_As_Out_Parameter (E : Entity_Id) return Boolean is
+ begin
+ return
+ (Warn_On_Modified_Unread and then Is_Only_Out_Parameter (E))
+ or else Warn_On_All_Unread_Out_Parameters;
+ end Warn_On_Modified_As_Out_Parameter;
+
------------------------------
-- Warn_On_Suspicious_Index --
------------------------------
case Ekind (E) is
when E_Variable =>
- -- Case of variable that is assigned but not read. We
- -- suppress the message if the variable is volatile, has an
- -- address clause, or is imported.
+ -- Case of variable that is assigned but not read. We suppress
+ -- the message if the variable is volatile, has an address
+ -- clause, is aliasied, or is a renaming, or is imported.
if Referenced_As_LHS_Check_Spec (E)
and then No (Address_Clause (E))
and then not Is_Volatile (E)
then
- if (Warn_On_Modified_Unread or Warn_On_Out_Parameter_Unread)
+ if Warn_On_Modified_Unread
and then not Is_Imported (E)
and then not Is_Return_Object (E)
-
- -- Suppress message for aliased or renamed variables,
- -- since there may be other entities that read the
- -- same memory location.
-
and then not Is_Aliased (E)
and then No (Renamed_Object (E))
Set_Last_Assignment (E, Empty);
end if;
- -- Normal case of neither assigned nor read
+ -- Normal case of neither assigned nor read (exclude variables
+ -- referenced as out parameters, since we already generated
+ -- appropriate warnings at the call point in this case).
+
+ elsif not Referenced_As_Out_Parameter (E) then
- else
-- We suppress the message for types for which a valid
-- pragma Unreferenced_Objects has been given, otherwise
-- we go ahead and give the message.
procedure Warn_On_Useless_Assignment
(Ent : Entity_Id;
- Loc : Source_Ptr := No_Location)
+ N : Node_Id := Empty)
is
- P : Node_Id;
- X : Node_Id;
+ P : Node_Id;
+ X : Node_Id;
function Check_Ref (N : Node_Id) return Traverse_Result;
-- Used to instantiate Traverse_Func. Returns Abandon if
-- Start of processing for Warn_On_Useless_Assignment
begin
- -- Check if this is a case we want to warn on, a variable with the
- -- last assignment field set, with warnings enabled, and which is
- -- not imported or exported.
+ -- Check if this is a case we want to warn on, a scalar or access
+ -- variable with the last assignment field set, with warnings enabled,
+ -- and which is not imported or exported. We also check that it is OK
+ -- to capture the value. We are not going to capture any value, but
+ -- the warning messages depends on the same kind of conditions.
if Is_Assignable (Ent)
and then not Is_Return_Object (Ent)
and then not Has_Pragma_Unreferenced_Check_Spec (Ent)
and then not Is_Imported (Ent)
and then not Is_Exported (Ent)
+ and then Safe_To_Capture_Value (N, Ent)
then
-- Before we issue the message, check covering exception handlers.
-- Search up tree for enclosing statement sequences and handlers
then
-- Case of assigned value never referenced
- if Loc = No_Location then
+ if No (N) then
-- Don't give this for OUT and IN OUT formals, since
-- clearly caller may reference the assigned value.
if Ekind (Ent) = E_Variable then
- Error_Msg_NE
- ("?useless assignment to&, value never referenced!",
- Last_Assignment (Ent), Ent);
+ if Referenced_As_Out_Parameter (Ent) then
+ Error_Msg_NE
+ ("?& modified by call, but value never referenced",
+ Last_Assignment (Ent), Ent);
+ else
+ Error_Msg_NE
+ ("?useless assignment to&, value never referenced!",
+ Last_Assignment (Ent), Ent);
+ end if;
end if;
-- Case of assigned value overwritten
else
- Error_Msg_Sloc := Loc;
- Error_Msg_NE
- ("?useless assignment to&, value overwritten #!",
- Last_Assignment (Ent), Ent);
+ Error_Msg_Sloc := Sloc (N);
+
+ if Referenced_As_Out_Parameter (Ent) then
+ Error_Msg_NE
+ ("?& modified by call, but value overwritten #!",
+ Last_Assignment (Ent), Ent);
+ else
+ Error_Msg_NE
+ ("?useless assignment to&, value overwritten #!",
+ Last_Assignment (Ent), Ent);
+ end if;
end if;
-- Clear last assignment indication and we are done
-- 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
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);
projects / thirdparty / gcc.git / commitdiff
