Skip to content

R
riscv-gcc-1
Commit 04568369 by Ed Schonberg Committed by Arnaud Charlet
Options

sem_warn.adb (Check_One_Unit): If the unit appears in a limited_with clause... 

2006-02-13  Ed Schonberg  <schonberg@adacore.com>

	* sem_warn.adb (Check_One_Unit): If the unit appears in a limited_with
	clause, use the limited view to determine whether any entity from it
	is referenced.

From-SVN: r111097
parent 4e73070a
Showing with 187 additions and 181 deletions
gcc/ada/sem_warn.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -58,26 +58,26 @@ package body Sem_Warn is ...@@ -58,26 +58,26 @@ package body Sem_Warn is
-- Handling of Conditionals -- -- Handling of Conditionals --
------------------------------ ------------------------------
-- Note: this is work in progress, the data structures and general -- Note: this is work in progress, the data structures and general approach
-- approach are defined, but are not in use yet. ??? -- are defined, but are not in use yet. ???
-- One entry is made in the following table for each branch of -- An entry is made in the following table for each branch of conditional,
-- a conditional, e.g. an if-then-elsif-else-endif structure -- e.g. an if-then-elsif-else-endif structure creates three entries in this
-- creates three entries in this table. -- table.
type Branch_Entry is record type Branch_Entry is record
Sloc : Source_Ptr; Sloc : Source_Ptr;
-- Location for warnings associated with this branch -- Location for warnings associated with this branch
Defs : Elist_Id; Defs : Elist_Id;
-- List of entities defined for the first time in this branch. On -- List of entities defined for the first time in this branch. On exit
-- exit from a conditional structure, any entity that is in the -- from a conditional structure, any entity that is in the list of all
-- list of all branches is removed (and the entity flagged as -- branches is removed (and the entity flagged as defined by the
-- defined by the conditional as a whole). Thus after processing -- conditional as a whole). Thus after processing a conditional, Defs
-- a conditional, Defs contains a list of entities defined in this -- contains a list of entities defined in this branch for the first
-- branch for the first time, but not defined at all in some other -- time, but not defined at all in some other branch of the same
-- branch of the same conditional. A value of No_Elist is used to -- conditional. A value of No_Elist is used to represent the initial
-- represent the initial empty list. -- empty list.
Next : Nat; Next : Nat;
-- Index of next branch for this conditional, zero = last branch -- Index of next branch for this conditional, zero = last branch
...@@ -91,8 +91,8 @@ package body Sem_Warn is ...@@ -91,8 +91,8 @@ package body Sem_Warn is
Table_Increment => Alloc.Branches_Increment, Table_Increment => Alloc.Branches_Increment,
Table_Name => "Branches"); Table_Name => "Branches");
-- The following table is used to represent conditionals, there is -- The following table is used to represent conditionals, there is one
-- one entry in this table for each conditional structure. -- entry in this table for each conditional structure.
type Conditional_Entry is record type Conditional_Entry is record
If_Stmt : Boolean; If_Stmt : Boolean;
...@@ -114,9 +114,9 @@ package body Sem_Warn is ...@@ -114,9 +114,9 @@ package body Sem_Warn is
Table_Name => "Conditionals"); Table_Name => "Conditionals");
-- The following table is a stack that keeps track of the current -- The following table is a stack that keeps track of the current
-- conditional. The Last entry is the top of the stack. An Empty -- conditional. The Last entry is the top of the stack. An Empty entry
-- entry represents the start of a compilation unit. Non-zero -- represents the start of a compilation unit. Non-zero entries in the
-- entries in the stack are indexes into the conditional table. -- stack are indexes into the conditional table.
package Conditional_Stack is new Table.Table ( package Conditional_Stack is new Table.Table (
Table_Component_Type => Nat, Table_Component_Type => Nat,
...@@ -143,10 +143,10 @@ package body Sem_Warn is ...@@ -143,10 +143,10 @@ package body Sem_Warn is
-- for the instance, when we will know more. -- for the instance, when we will know more.
function Operand_Has_Warnings_Suppressed (N : Node_Id) return Boolean; function Operand_Has_Warnings_Suppressed (N : Node_Id) return Boolean;
-- This function traverses the expression tree represented by the node -- This function traverses the expression tree represented by the node N
-- N and determines if any sub-operand is a reference to an entity for -- and determines if any sub-operand is a reference to an entity for which
-- which the Warnings_Off flag is set. True is returned if such an -- the Warnings_Off flag is set. True is returned if such an entity is
-- entity is encountered, and False otherwise. -- encountered, and False otherwise.
---------------------- ----------------------
-- Check_References -- -- Check_References --
...@@ -158,18 +158,18 @@ package body Sem_Warn is ...@@ -158,18 +158,18 @@ package body Sem_Warn is
function Missing_Subunits return Boolean; function Missing_Subunits return Boolean;
-- We suppress warnings when there are missing subunits, because this -- We suppress warnings when there are missing subunits, because this
-- may generate too many false positives: entities in a parent may -- may generate too many false positives: entities in a parent may only
-- only be referenced in one of the subunits. We make an exception -- be referenced in one of the subunits. We make an exception for
-- for subunits that contain no other stubs. -- subunits that contain no other stubs.
procedure Output_Reference_Error (M : String); procedure Output_Reference_Error (M : String);
-- Used to output an error message. Deals with posting the error on -- Used to output an error message. Deals with posting the error on the
-- the body formal in the accept case. -- body formal in the accept case.
function Publicly_Referenceable (Ent : Entity_Id) return Boolean; function Publicly_Referenceable (Ent : Entity_Id) return Boolean;
-- This is true if the entity in question is potentially referenceable -- This is true if the entity in question is potentially referenceable
-- from another unit. This is true for entities in packages that are -- from another unit. This is true for entities in packages that are at
-- at the library level. -- the library level.
---------------------- ----------------------
-- Missing_Subunits -- -- Missing_Subunits --
...@@ -193,7 +193,6 @@ package body Sem_Warn is ...@@ -193,7 +193,6 @@ package body Sem_Warn is
elsif Nkind (Unit_Declaration_Node (E)) in N_Proper_Body then elsif Nkind (Unit_Declaration_Node (E)) in N_Proper_Body then
D := First (Declarations (Unit_Declaration_Node (E))); D := First (Declarations (Unit_Declaration_Node (E)));
while Present (D) loop while Present (D) loop
-- No warnings if the proper body contains nested stubs -- No warnings if the proper body contains nested stubs
...@@ -238,7 +237,6 @@ package body Sem_Warn is ...@@ -238,7 +237,6 @@ package body Sem_Warn is
if Present (Parameter_Specifications (Anod)) then if Present (Parameter_Specifications (Anod)) then
Parm := First (Parameter_Specifications (Anod)); Parm := First (Parameter_Specifications (Anod));
while Present (Parm) loop while Present (Parm) loop
Defid := Defining_Identifier (Parm); Defid := Defining_Identifier (Parm);
...@@ -265,9 +263,9 @@ package body Sem_Warn is ...@@ -265,9 +263,9 @@ package body Sem_Warn is
Prev : Node_Id; Prev : Node_Id;
begin begin
-- Examine parents to look for a library level package spec -- Examine parents to look for a library level package spec. But if
-- But if we find a body or block or other similar construct -- we find a body or block or other similar construct along the way,
-- along the way, we cannot be referenced. -- we cannot be referenced.
Prev := Ent; Prev := Ent;
P := Parent (Ent); P := Parent (Ent);
...@@ -283,7 +281,8 @@ package body Sem_Warn is ...@@ -283,7 +281,8 @@ package body Sem_Warn is
-- consider this referenceable, since any instantiation will -- consider this referenceable, since any instantiation will
-- have access to the entities in the generic package. Note -- have access to the entities in the generic package. Note
-- that the package itself may not be instantiated, but then -- that the package itself may not be instantiated, but then
-- we will get a warning for the package entity -- we will get a warning for the package entity.
-- Note that generic formal parameters are themselves not -- Note that generic formal parameters are themselves not
-- publicly referenceable in an instance, and warnings on -- publicly referenceable in an instance, and warnings on
-- them are useful. -- them are useful.
...@@ -341,9 +340,9 @@ package body Sem_Warn is ...@@ -341,9 +340,9 @@ package body Sem_Warn is
-- Start of processing for Check_References -- Start of processing for Check_References
begin begin
-- No messages if warnings are suppressed, or if we have detected -- No messages if warnings are suppressed, or if we have detected any
-- any real errors so far (this last check avoids junk messages -- real errors so far (this last check avoids junk messages resulting
-- resulting from errors, e.g. a subunit that is not loaded). -- from errors, e.g. a subunit that is not loaded).
if Warning_Mode = Suppress if Warning_Mode = Suppress
or else Serious_Errors_Detected /= 0 or else Serious_Errors_Detected /= 0
...@@ -376,9 +375,9 @@ package body Sem_Warn is ...@@ -376,9 +375,9 @@ package body Sem_Warn is
(Ekind (E1) = E_Out_Parameter (Ekind (E1) = E_Out_Parameter
and then not Is_Protected_Type (Current_Scope)) and then not Is_Protected_Type (Current_Scope))
then then
-- Post warning if this object not assigned. Note that we -- Post warning if this object not assigned. Note that we do
-- do not consider the implicit initialization of an access -- not consider the implicit initialization of an access type
-- type to be the assignment of a value for this purpose. -- to be the assignment of a value for this purpose.
if Ekind (E1) = E_Out_Parameter if Ekind (E1) = E_Out_Parameter
and then Present (Spec_Entity (E1)) and then Present (Spec_Entity (E1))
...@@ -401,14 +400,13 @@ package body Sem_Warn is ...@@ -401,14 +400,13 @@ package body Sem_Warn is
and then Is_Access_Type (Etype (E1)) and then Is_Access_Type (Etype (E1))
then then
-- For access types, the only time we made a UR -- For access types, the only time we made a UR entry was
-- entry was for a dereference, and so we post -- for a dereference, and so we post the appropriate warning
-- the appropriate warning here (note that the -- here (note that the dereference may not be explicit in
-- dereference may not be explicit in the source, -- the source, for example in the case of a dispatching call
-- for example in the case of a dispatching call -- with an anonymous access controlling formal, or of an
-- with an anonymous access controlling formal, or -- assignment of a pointer involving discriminant check on
-- of an assignment of a pointer involving a -- the designated object).
-- discriminant check on the designated object).
Error_Msg_NE ("& may be null?", UR, E1); Error_Msg_NE ("& may be null?", UR, E1);
goto Continue; goto Continue;
...@@ -502,14 +500,13 @@ package body Sem_Warn is ...@@ -502,14 +500,13 @@ package body Sem_Warn is
UR := Expression (UR); UR := Expression (UR);
end loop; end loop;
-- Here we issue the warning, all checks completed -- Here we issue the warning, all checks completed If the
-- If the unset reference is prefix of a selected -- unset reference is prefix of a selected component that
-- component that comes from source, mention the -- comes from source, mention the component as well. If the
-- component as well. If the selected component comes -- selected component comes from expansion, all we know is
-- from expansion, all we know is that the entity is -- that the entity is not fully initialized at the point of
-- not fully initialized at the point of the reference. -- the reference. Locate an unintialized component to get a
-- Locate an unintialized component to get a better -- better error message.
-- error message.
if Nkind (Parent (UR)) = N_Selected_Component then if Nkind (Parent (UR)) = N_Selected_Component then
Error_Msg_Node_2 := Selector_Name (Parent (UR)); Error_Msg_Node_2 := Selector_Name (Parent (UR));
...@@ -565,9 +562,9 @@ package body Sem_Warn is ...@@ -565,9 +562,9 @@ package body Sem_Warn is
and then Referenced_As_LHS (E1))) and then Referenced_As_LHS (E1)))
-- Labels, and enumeration literals, and exceptions. The -- Labels, and enumeration literals, and exceptions. The
-- warnings are also placed on local packages that cannot -- warnings are also placed on local packages that cannot be
-- be referenced from elsewhere, including those declared -- referenced from elsewhere, including those declared within a
-- within a package body. -- package body.
and then (Is_Object (E1) and then (Is_Object (E1)
or else or else
...@@ -591,8 +588,8 @@ package body Sem_Warn is ...@@ -591,8 +588,8 @@ package body Sem_Warn is
or else Ekind (E) = E_Subprogram_Body or else Ekind (E) = E_Subprogram_Body
or else Ekind (E) = E_Block))) or else Ekind (E) = E_Block)))
-- Exclude instantiations, since there is no reason why -- Exclude instantiations, since there is no reason why every
-- every entity in an instantiation should be referenced. -- entity in an instantiation should be referenced.
and then Instantiation_Location (Sloc (E1)) = No_Location and then Instantiation_Location (Sloc (E1)) = No_Location
...@@ -628,49 +625,49 @@ package body Sem_Warn is ...@@ -628,49 +625,49 @@ package body Sem_Warn is
and then not Is_Dispatching_Operation (E1) and then not Is_Dispatching_Operation (E1)
-- Check entity that can be publicly referenced (we do not -- Check entity that can be publicly referenced (we do not give
-- give messages for such entities, since there could be -- messages for such entities, since there could be other
-- other units, not involved in this compilation, that -- units, not involved in this compilation, that contain
-- contain relevant references. -- relevant references.
and then not Publicly_Referenceable (E1) and then not Publicly_Referenceable (E1)
-- Class wide types are marked as source entities, but -- Class wide types are marked as source entities, but they are
-- they are not really source entities, and are always -- not really source entities, and are always created, so we do
-- created, so we do not care if they are not referenced. -- not care if they are not referenced.
and then Ekind (E1) /= E_Class_Wide_Type and then Ekind (E1) /= E_Class_Wide_Type
-- Objects other than parameters of task types are allowed -- Objects other than parameters of task types are allowed to
-- to be non-referenced, since they start up tasks! -- be non-referenced, since they start up tasks!
and then ((Ekind (E1) /= E_Variable and then ((Ekind (E1) /= E_Variable
and then Ekind (E1) /= E_Constant and then Ekind (E1) /= E_Constant
and then Ekind (E1) /= E_Component) and then Ekind (E1) /= E_Component)
or else not Is_Task_Type (Etype (E1))) or else not Is_Task_Type (Etype (E1)))
-- For subunits, only place warnings on the main unit -- For subunits, only place warnings on the main unit itself,
-- itself, since parent units are not completely compiled -- since parent units are not completely compiled
and then (Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit and then (Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit
or else or else
Get_Source_Unit (E1) = Main_Unit) Get_Source_Unit (E1) = Main_Unit)
then then
-- Suppress warnings in internal units if not in -gnatg -- Suppress warnings in internal units if not in -gnatg mode
-- mode (these would be junk warnings for an applications -- (these would be junk warnings for an applications program,
-- program, since they refer to problems in internal units) -- since they refer to problems in internal units)
if GNAT_Mode if GNAT_Mode
or else not or else not
Is_Internal_File_Name Is_Internal_File_Name
(Unit_File_Name (Get_Source_Unit (E1))) (Unit_File_Name (Get_Source_Unit (E1)))
then then
-- We do not immediately flag the error. This is because -- We do not immediately flag the error. This is because we
-- we have not expanded generic bodies yet, and they may -- have not expanded generic bodies yet, and they may have
-- have the missing reference. So instead we park the -- the missing reference. So instead we park the entity on a
-- entity on a list, for later processing. However, for -- list, for later processing. However, for the accept case,
-- the accept case, post the error right here, since we -- post the error right here, since we have the information
-- have the information now in this case. -- now in this case.
if Present (Anod) then if Present (Anod) then
Output_Reference_Error ("& is not referenced?"); Output_Reference_Error ("& is not referenced?");
...@@ -682,10 +679,10 @@ package body Sem_Warn is ...@@ -682,10 +679,10 @@ package body Sem_Warn is
end if; end if;
end if; end if;
-- Generic units are referenced in the generic body, -- Generic units are referenced in the generic body, but if they
-- but if they are not public and never instantiated -- are not public and never instantiated we want to force a
-- we want to force a warning on them. We treat them -- warning on them. We treat them as redundant constructs to
-- as redundant constructs to minimize noise. -- minimize noise.
elsif Is_Generic_Subprogram (E1) elsif Is_Generic_Subprogram (E1)
and then not Is_Instantiated (E1) and then not Is_Instantiated (E1)
...@@ -733,9 +730,9 @@ package body Sem_Warn is ...@@ -733,9 +730,9 @@ package body Sem_Warn is
return; return;
end if; end if;
-- Ignore reference to non-scalar if not from source. Almost always -- Ignore reference to non-scalar if not from source. Almost always such
-- such references are bogus (e.g. calls to init procs to set -- references are bogus (e.g. calls to init procs to set default
-- default discriminant values). -- discriminant values).
if not Comes_From_Source (N) if not Comes_From_Source (N)
and then not Is_Scalar_Type (Etype (N)) and then not Is_Scalar_Type (Etype (N))
...@@ -765,16 +762,16 @@ package body Sem_Warn is ...@@ -765,16 +762,16 @@ package body Sem_Warn is
(Sloc (N), Sloc (Unset_Reference (E)))) (Sloc (N), Sloc (Unset_Reference (E))))
and then not Warnings_Off (E) and then not Warnings_Off (E)
then then
-- We may have an unset reference. The first test is -- We may have an unset reference. The first test is whether
-- whether we are accessing a discriminant of a record -- we are accessing a discriminant of a record or a
-- or a component with default initialization. Both of -- component with default initialization. Both of these
-- these cases can be ignored, since the actual object -- cases can be ignored, since the actual object that is
-- that is referenced is definitely initialized. Note -- referenced is definitely initialized. Note that this
-- that this covers the case of reading discriminants -- covers the case of reading discriminants of an out
-- of an out parameter, which is OK even in Ada 83. -- parameter, which is OK even in Ada 83.
-- Note that we are only interested in a direct reference -- Note that we are only interested in a direct reference to
-- to a record component here. If the reference is via an -- a record component here. If the reference is via an
-- access type, then the access object is being referenced, -- access type, then the access object is being referenced,
-- not the record, and still deserves an unset reference. -- not the record, and still deserves an unset reference.
...@@ -797,11 +794,11 @@ package body Sem_Warn is ...@@ -797,11 +794,11 @@ package body Sem_Warn is
-- Here we have a potential unset reference. But before we -- Here we have a potential unset reference. But before we
-- get worried about it, we have to make sure that the -- get worried about it, we have to make sure that the
-- entity declaration is in the same procedure as the -- entity declaration is in the same procedure as the
-- reference, since if they are in separate procedures, -- reference, since if they are in separate procedures, then
-- then we have no idea about sequential execution. -- we have no idea about sequential execution.
-- The tests in the loop below catch all such cases, but -- The tests in the loop below catch all such cases, but do
-- do allow the reference to appear in a loop, block, or -- allow the reference to appear in a loop, block, or
-- package spec that is nested within the declaring scope. -- package spec that is nested within the declaring scope.
-- As always, it is possible to construct cases where the -- As always, it is possible to construct cases where the
-- warning is wrong, that is why it is a warning! -- warning is wrong, that is why it is a warning!
...@@ -824,25 +821,29 @@ package body Sem_Warn is ...@@ -824,25 +821,29 @@ package body Sem_Warn is
SR := Scope (SR); SR := Scope (SR);
end loop; end loop;
-- Case of reference has an access type. This is a -- Case of reference has an access type. This is special
-- special case since access types are always set to -- case since access types are always set to null so
-- null so cannot be truly uninitialized, but we still -- cannot be truly uninitialized, but we still want to
-- want to warn about cases of obvious null dereference. -- warn about cases of obvious null dereference.
if Is_Access_Type (Etype (N)) then if Is_Access_Type (Etype (N)) then
declare Access_Type_Case : declare
P : Node_Id; P : Node_Id;
function Process function Process
(N : Node_Id) (N : Node_Id)
return Traverse_Result; return Traverse_Result;
-- Process function for instantation of Traverse -- Process function for instantation of Traverse
-- below. Checks if N contains reference to E -- below. Checks if N contains reference to other
-- other than a dereference. -- than a dereference.
function Ref_In (Nod : Node_Id) return Boolean; function Ref_In (Nod : Node_Id) return Boolean;
-- Determines whether Nod contains a reference -- Determines whether Nod contains a reference to
-- to the entity E that is not a dereference. -- the entity E that is not a dereference.
-------------
-- Process --
-------------
function Process function Process
(N : Node_Id) (N : Node_Id)
...@@ -859,13 +860,18 @@ package body Sem_Warn is ...@@ -859,13 +860,18 @@ package body Sem_Warn is
end if; end if;
end Process; end Process;
------------
-- Ref_In --
------------
function Ref_In (Nod : Node_Id) return Boolean is function Ref_In (Nod : Node_Id) return Boolean is
function Traverse is new Traverse_Func (Process); function Traverse is new Traverse_Func (Process);
begin begin
return Traverse (Nod) = Abandon; return Traverse (Nod) = Abandon;
end Ref_In; end Ref_In;
-- Start of processing for Access_Type_Case
begin begin
-- Don't bother if we are inside an instance, -- Don't bother if we are inside an instance,
-- since the compilation of the generic template -- since the compilation of the generic template
...@@ -918,7 +924,7 @@ package body Sem_Warn is ...@@ -918,7 +924,7 @@ package body Sem_Warn is
return; return;
end if; end if;
end loop; end loop;
end; end Access_Type_Case;
end if; end if;
-- Here we definitely have a case for giving a warning -- Here we definitely have a case for giving a warning
...@@ -1035,7 +1041,6 @@ package body Sem_Warn is ...@@ -1035,7 +1041,6 @@ package body Sem_Warn is
begin begin
if Nkind (N) = N_Use_Package_Clause then if Nkind (N) = N_Use_Package_Clause then
Nam := First (Names (N)); Nam := First (Names (N));
while Present (Nam) loop while Present (Nam) loop
if Entity (Nam) = Pack then if Entity (Nam) = Pack then
Error_Msg_Qual_Level := 1; Error_Msg_Qual_Level := 1;
...@@ -1056,7 +1061,6 @@ package body Sem_Warn is ...@@ -1056,7 +1061,6 @@ package body Sem_Warn is
begin begin
E := First_Entity (Pack); E := First_Entity (Pack);
while Present (E) loop while Present (E) loop
if Referenced (E) then if Referenced (E) then
return; return;
...@@ -1065,9 +1069,9 @@ package body Sem_Warn is ...@@ -1065,9 +1069,9 @@ package body Sem_Warn is
Next_Entity (E); Next_Entity (E);
end loop; end loop;
-- No entities of the package are referenced. Check whether -- No entities of the package are referenced. Check whether the
-- the reference to the package itself is a use clause, and -- reference to the package itself is a use clause, and if so
-- if so place a warning on it. -- place a warning on it.
Check_Use_Clauses (Un); Check_Use_Clauses (Un);
end Check_Inner_Package; end Check_Inner_Package;
...@@ -1085,7 +1089,6 @@ package body Sem_Warn is ...@@ -1085,7 +1089,6 @@ package body Sem_Warn is
and then Present_System_Aux and then Present_System_Aux
then then
Ent := First_Entity (System_Aux_Id); Ent := First_Entity (System_Aux_Id);
while Present (Ent) loop while Present (Ent) loop
if Referenced (Ent) then if Referenced (Ent) then
return True; return True;
...@@ -1111,8 +1114,8 @@ package body Sem_Warn is ...@@ -1111,8 +1114,8 @@ package body Sem_Warn is
begin begin
Is_Visible_Renaming := False; Is_Visible_Renaming := False;
E1 := First_Entity (P);
E1 := First_Entity (P);
while Present (E1) loop while Present (E1) loop
if Ekind (E1) = E_Package if Ekind (E1) = E_Package
and then Renamed_Object (E1) = L and then Renamed_Object (E1) = L
...@@ -1143,17 +1146,17 @@ package body Sem_Warn is ...@@ -1143,17 +1146,17 @@ package body Sem_Warn is
begin begin
Cnode := Cunit (Unit); Cnode := Cunit (Unit);
-- Only do check in units that are part of the extended main -- Only do check in units that are part of the extended main unit.
-- unit. This is actually a necessary restriction, because in -- This is actually a necessary restriction, because in the case of
-- the case of subprogram acting as its own specification, -- subprogram acting as its own specification, there can be with's in
-- there can be with's in subunits that we will not see. -- subunits that we will not see.
if not In_Extended_Main_Source_Unit (Cnode) then if not In_Extended_Main_Source_Unit (Cnode) then
return; return;
-- In configurable run time mode, we remove the bodies of -- In configurable run time mode, we remove the bodies of non-inlined
-- non-inlined subprograms, which may lead to spurious warnings, -- subprograms, which may lead to spurious warnings, which are
-- which are clearly undesirable. -- clearly undesirable.
elsif Configurable_Run_Time_Mode elsif Configurable_Run_Time_Mode
and then Is_Predefined_File_Name (Unit_File_Name (Unit)) and then Is_Predefined_File_Name (Unit_File_Name (Unit))
...@@ -1175,16 +1178,16 @@ package body Sem_Warn is ...@@ -1175,16 +1178,16 @@ package body Sem_Warn is
if not Referenced (Lunit) then if not Referenced (Lunit) then
-- Suppress warnings in internal units if not in -gnatg -- Suppress warnings in internal units if not in -gnatg mode
-- mode (these would be junk warnings for an applications -- (these would be junk warnings for an application program,
-- program, since they refer to problems in internal units) -- since they refer to problems in internal units)
if GNAT_Mode if GNAT_Mode
or else not Is_Internal_File_Name (Unit_File_Name (Unit)) or else not Is_Internal_File_Name (Unit_File_Name (Unit))
then then
-- Here we definitely have a non-referenced unit. If -- Here we definitely have a non-referenced unit. If it
-- it is the special call for a spec unit, then just -- is the special call for a spec unit, then just set the
-- set the flag to be read later. -- flag to be read later.
if Unit = Spec_Unit then if Unit = Spec_Unit then
Set_Unreferenced_In_Spec (Item); Set_Unreferenced_In_Spec (Item);
...@@ -1205,26 +1208,26 @@ package body Sem_Warn is ...@@ -1205,26 +1208,26 @@ package body Sem_Warn is
then then
null; null;
-- If this unit is referenced, and it is a package, we -- If this unit is referenced, and it is a package, we do
-- do another test, to see if any of the entities in the -- another test, to see if any of the entities in the package
-- package are referenced. If none of the entities are -- are referenced. If none of the entities are referenced, we
-- referenced, we still post a warning. This occurs if -- still post a warning. This occurs if the only use of the
-- the only use of the package is in a use clause, or -- package is in a use clause, or in a package renaming
-- in a package renaming declaration. -- declaration.
elsif Ekind (Lunit) = E_Package then elsif Ekind (Lunit) = E_Package then
-- If Is_Instantiated is set, it means that the package -- If Is_Instantiated is set, it means that the package is
-- is implicitly instantiated (this is the case of a -- implicitly instantiated (this is the case of parent
-- parent instance or an actual for a generic package -- instance or an actual for a generic package formal), and
-- formal), and this counts as a reference. -- this counts as a reference.
if Is_Instantiated (Lunit) then if Is_Instantiated (Lunit) then
null; null;
-- If no entities in package, and there is a pragma -- If no entities in package, and there is a pragma
-- Elaborate_Body present, then assume that this with -- Elaborate_Body present, then assume that this with is
-- is done for purposes of this elaboration. -- done for purposes of this elaboration.
elsif No (First_Entity (Lunit)) elsif No (First_Entity (Lunit))
and then Has_Pragma_Elaborate_Body (Lunit) and then Has_Pragma_Elaborate_Body (Lunit)
...@@ -1234,12 +1237,16 @@ package body Sem_Warn is ...@@ -1234,12 +1237,16 @@ package body Sem_Warn is
-- Otherwise see if any entities have been referenced -- Otherwise see if any entities have been referenced
else else
if Limited_Present (Item) then
Ent := First_Entity (Limited_View (Lunit));
else
Ent := First_Entity (Lunit); Ent := First_Entity (Lunit);
end if;
loop loop
-- No more entities, and we did not find one -- No more entities, and we did not find one that was
-- that was referenced. Means we have a definite -- referenced. Means we have a definite case of a with
-- case of a with none of whose entities was -- none of whose entities was referenced.
-- referenced.
if No (Ent) then if No (Ent) then
...@@ -1258,10 +1265,10 @@ package body Sem_Warn is ...@@ -1258,10 +1265,10 @@ package body Sem_Warn is
("no entities of & are referenced?", ("no entities of & are referenced?",
Name (Item)); Name (Item));
-- Look for renamings of this package, and -- Look for renamings of this package, and flag
-- flag them as well. If the original package -- them as well. If the original package has
-- has warnings off, we suppress the warning -- warnings off, we suppress the warning on the
-- on the renaming as well. -- renaming as well.
Pack := Find_Package_Renaming (Munite, Lunit); Pack := Find_Package_Renaming (Munite, Lunit);
...@@ -1282,16 +1289,16 @@ package body Sem_Warn is ...@@ -1282,16 +1289,16 @@ package body Sem_Warn is
elsif Referenced (Ent) elsif Referenced (Ent)
or else Referenced_As_LHS (Ent) or else Referenced_As_LHS (Ent)
then then
-- This means that the with is indeed fine, in -- This means that the with is indeed fine, in that
-- that it is definitely needed somewhere, and -- it is definitely needed somewhere, and we can
-- we can quite worrying about this one. -- quite worrying about this one.
-- Except for one little detail, if either of -- Except for one little detail, if either of the
-- the flags was set during spec processing, -- flags was set during spec processing, this is
-- this is where we complain that the with -- where we complain that the with could be moved
-- could be moved from the spec. If the spec -- from the spec. If the spec contains a visible
-- contains a visible renaming of the package, -- renaming of the package, inhibit warning to move
-- inhibit warning to move with_clause to body. -- with_clause to body.
if Ekind (Munite) = E_Package_Body then if Ekind (Munite) = E_Package_Body then
Pack := Pack :=
...@@ -1334,8 +1341,8 @@ package body Sem_Warn is ...@@ -1334,8 +1341,8 @@ package body Sem_Warn is
end if; end if;
-- For a generic package, the only interesting kind of -- For a generic package, the only interesting kind of
-- reference is an instantiation, since entities cannot -- reference is an instantiation, since entities cannot be
-- be referenced directly. -- referenced directly.
elsif Is_Generic_Unit (Lunit) then elsif Is_Generic_Unit (Lunit) then
...@@ -1350,9 +1357,9 @@ package body Sem_Warn is ...@@ -1350,9 +1357,9 @@ package body Sem_Warn is
("unit& is never instantiated?", Name (Item)); ("unit& is never instantiated?", Name (Item));
end if; end if;
-- If unit was indeed instantiated, make sure that -- If unit was indeed instantiated, make sure that flag is
-- flag is not set showing it was uninstantiated in -- not set showing it was uninstantiated in the spec, and if
-- the spec, and if so, give warning. -- so, give warning.
elsif Unreferenced_In_Spec (Item) then elsif Unreferenced_In_Spec (Item) then
Error_Msg_N Error_Msg_N
...@@ -1377,11 +1384,11 @@ package body Sem_Warn is ...@@ -1377,11 +1384,11 @@ package body Sem_Warn is
return; return;
end if; end if;
-- Flag any unused with clauses, but skip this step if we are -- Flag any unused with clauses, but skip this step if we are compiling
-- compiling a subunit on its own, since we do not have enough -- a subunit on its own, since we do not have enough information to
-- information to determine whether with's are used. We will get -- determine whether with's are used. We will get the relevant warnings
-- the relevant warnings when we compile the parent. This is the -- when we compile the parent. This is the normal style of GNAT
-- normal style of GNAT compilation in any case. -- compilation in any case.
if Nkind (Unit (Cunit (Main_Unit))) = N_Subunit then if Nkind (Unit (Cunit (Main_Unit))) = N_Subunit then
return; return;
...@@ -1417,7 +1424,6 @@ package body Sem_Warn is ...@@ -1417,7 +1424,6 @@ package body Sem_Warn is
else else
S := Scope (E); S := Scope (E);
loop loop
if S = Standard_Standard then if S = Standard_Standard then
return False; return False;
...@@ -1500,8 +1506,8 @@ package body Sem_Warn is ...@@ -1500,8 +1506,8 @@ package body Sem_Warn is
when E_Variable => when E_Variable =>
-- Case of variable that is assigned but not read. We -- Case of variable that is assigned but not read. We
-- suppress the message if the variable is volatile, -- suppress the message if the variable is volatile, has an
-- has an address clause, or is imported. -- address clause, or is imported.
if Referenced_As_LHS (E) if Referenced_As_LHS (E)
and then No (Address_Clause (E)) and then No (Address_Clause (E))
...@@ -1511,8 +1517,8 @@ package body Sem_Warn is ...@@ -1511,8 +1517,8 @@ package body Sem_Warn is
and then not Is_Imported (E) and then not Is_Imported (E)
-- Suppress the message for aliased or renamed -- Suppress the message for aliased or renamed
-- variables, since there may be other entities -- variables, since there may be other entities read
-- read the same memory location. -- the same memory location.
and then not Is_Aliased (E) and then not Is_Aliased (E)
and then No (Renamed_Object (E)) and then No (Renamed_Object (E))
...@@ -1784,8 +1790,8 @@ package body Sem_Warn is ...@@ -1784,8 +1790,8 @@ package body Sem_Warn is
P : Node_Id; P : Node_Id;
begin begin
-- Argument replacement in an inlined body can make conditions -- Argument replacement in an inlined body can make conditions static.
-- static. Do not emit warnings in this case. -- Do not emit warnings in this case.
if In_Inlined_Body then if In_Inlined_Body then
return; return;
......
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