Skip to content

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

sem_ch5.adb: Improve warnings on redundant assignments 

2007-08-14  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb: Improve warnings on redundant assignments

	* sem_util.ads, sem_util.adb: (Is_Variable): Add defense against junk
	parameter
	(Is_Synchronized_Tagged_Type): New subprogram that returns true
	in case of synchronized tagged types (AARM 3.9.4 (6/2)).
	(Safe_To_Capture_Value): Can now return True for constants, even if Cond
	is set to False. Improves handling of Known_[Not_]Null.
	(Wrong_Type): Special case address arithmetic attempt
	(Collect_Abstract_Interfaces): Add new formal to allow collecting
	abstract interfaces just using the partial view of private types.
	(Has_Abstract_Interfaces): Add new formal to allow checking types
	covering interfaces using the partial view of private types.
	(Is_Fully_Initialized_Type): Special VM case for uTag component. This
	component still needs to be defined in this case, but is never
	initialized as VMs are using other dispatching mechanisms.
	(Abstract_Interface_List): For a protected type, use base type to get
	proper declaration.
	Improve warnings on redundant assignments
	(Is_Variable): Handle properly an implicit dereference of a prefixed
	function call.
	(Build_Actual_Subtype): If this is an actual subtype for an
	unconstrained formal parameter, use the sloc of the body for the new
	declaration, to prevent anomalises in the debugger.

From-SVN: r127427
parent dc06abec
Showing with 87 additions and 32 deletions
gcc/ada/sem_ch5.adb
......@@ -250,7 +250,8 @@ package body Sem_Ch5 is
-- Start of processing for Analyze_Assignment
begin
Mark_Static_Coextensions (Rhs);
Mark_Coextensions (N, Rhs);
Analyze (Rhs);
Analyze (Lhs);
......@@ -579,10 +580,10 @@ package body Sem_Ch5 is
and then Can_Never_Be_Null (T1)
and then not Assignment_OK (Lhs)
then
if Nkind (Rhs) = N_Null then
if Known_Null (Rhs) then
Apply_Compile_Time_Constraint_Error
(N => Rhs,
Msg => "(Ada 2005) NULL not allowed in null-excluding objects?",
Msg => "(Ada 2005) null not allowed in null-excluding objects?",
Reason => CE_Null_Not_Allowed);
return;
......@@ -640,11 +641,9 @@ package body Sem_Ch5 is
and then Comes_From_Source (N)
-- Where the entity is the same on both sides
-- Where the object is the same on both sides
and then Is_Entity_Name (Lhs)
and then Is_Entity_Name (Original_Node (Rhs))
and then Entity (Lhs) = Entity (Original_Node (Rhs))
and then Same_Object (Lhs, Original_Node (Rhs))
-- But exclude the case where the right side was an operation
-- that got rewritten (e.g. JUNK + K, where K was known to be
......@@ -654,8 +653,13 @@ package body Sem_Ch5 is
and then Nkind (Original_Node (Rhs)) not in N_Op
then
if Nkind (Lhs) in N_Has_Entity then
Error_Msg_NE
("?useless assignment of & to itself", N, Entity (Lhs));
("?useless assignment of & to itself!", N, Entity (Lhs));
else
Error_Msg_N
("?useless assignment of object to itself!", N);
end if;
end if;
-- Check for non-allowed composite assignment
......@@ -1071,7 +1075,6 @@ package body Sem_Ch5 is
begin
Alt := First (Alternatives (N));
while Present (Alt) loop
if Alt /= Chosen then
Remove_Warning_Messages (Statements (Alt));
......@@ -1341,7 +1344,6 @@ package body Sem_Ch5 is
if Present (Elsif_Parts (N)) then
E := First (Elsif_Parts (N));
while Present (E) loop
Remove_Warning_Messages (Then_Statements (E));
Next (E);
......@@ -2035,7 +2037,7 @@ package body Sem_Ch5 is
-- the Ada RM annoyingly requires a useless return here!
if Nkind (Original_Node (N)) /= N_Raise_Statement
or else Nkind (Nxt) /= N_Return_Statement
or else Nkind (Nxt) /= N_Simple_Return_Statement
then
-- The rather strange shenanigans with the warning message
-- here reflects the fact that Kill_Dead_Code is very good
......@@ -2077,7 +2079,7 @@ package body Sem_Ch5 is
-- Now issue the warning
Error_Msg ("?unreachable code", Error_Loc);
Error_Msg ("?unreachable code!", Error_Loc);
end if;
-- If the unconditional transfer of control instruction is
......
gcc/ada/sem_util.ads
......@@ -28,6 +28,7 @@
with Einfo; use Einfo;
with Namet; use Namet;
with Nmake;
with Types; use Types;
with Uintp; use Uintp;
with Urealp; use Urealp;
......@@ -147,10 +148,13 @@ package Sem_Util is
procedure Collect_Abstract_Interfaces
(T : Entity_Id;
Ifaces_List : out Elist_Id;
Exclude_Parent_Interfaces : Boolean := False);
Exclude_Parent_Interfaces : Boolean := False;
Use_Full_View : Boolean := True);
-- Ada 2005 (AI-251): Collect whole list of abstract interfaces that are
-- directly or indirectly implemented by T. Exclude_Parent_Interfaces is
-- used to avoid addition of inherited interfaces to the generated list.
-- Use_Full_View is used to collect the interfaces using the full-view
-- (if available).
procedure Collect_Interface_Components
(Tagged_Type : Entity_Id;
......@@ -158,6 +162,17 @@ package Sem_Util is
-- Ada 2005 (AI-251): Collect all the tag components associated with the
-- secondary dispatch tables of a tagged type.
procedure Collect_Interfaces_Info
(T : Entity_Id;
Ifaces_List : out Elist_Id;
Components_List : out Elist_Id;
Tags_List : out Elist_Id);
-- Ada 2005 (AI-251): Collect all the interfaces associated with T plus
-- the record component and tag associated with each of these interfaces.
-- On exit Ifaces_List, Components_List and Tags_List have the same number
-- of elements, and elements at the same position on these tables provide
-- information on the same interface type.
function Collect_Primitive_Operations (T : Entity_Id) return Elist_Id;
-- Called upon type derivation and extension. We scan the declarative
-- part in which the type appears, and collect subprograms that have
......@@ -282,7 +297,7 @@ package Sem_Util is
(Def_Id : Entity_Id;
First_Hom : Entity_Id;
Ifaces_List : Elist_Id;
In_Scope : Boolean := True) return Entity_Id;
In_Scope : Boolean) return Entity_Id;
-- Determine whether entry or subprogram Def_Id overrides a primitive
-- operation that belongs to one of the interfaces in Ifaces_List. A
-- specific homonym chain can be specified by setting First_Hom. Flag
......@@ -443,8 +458,12 @@ package Sem_Util is
-- Result of Has_Compatible_Alignment test, description found below. Note
-- that the values are arranged in increasing order of problematicness.
function Has_Abstract_Interfaces (Tagged_Type : Entity_Id) return Boolean;
-- Returns true if Tagged_Type implements some abstract interface
function Has_Abstract_Interfaces
(Tagged_Type : Entity_Id;
Use_Full_View : Boolean := True) return Boolean;
-- Returns true if Tagged_Type implements some abstract interface. In case
-- private types the argument Use_Full_View controls if the check is done
-- using its full view (if available).
function Has_Compatible_Alignment
(Obj : Entity_Id;
......@@ -689,6 +708,9 @@ package Sem_Util is
-- the N_Statement_Other_Than_Procedure_Call subtype from Sinfo).
-- Note that a label is *not* a statement, and will return False.
function Is_Synchronized_Tagged_Type (E : Entity_Id) return Boolean;
-- Returns True if E is a synchronized tagged type (AARM 3.9.4 (6/2))
function Is_Transfer (N : Node_Id) return Boolean;
-- Returns True if the node N is a statement which is known to cause
-- an unconditional transfer of control at runtime, i.e. the following
......@@ -723,17 +745,16 @@ package Sem_Util is
procedure Kill_Current_Values;
-- This procedure is called to clear all constant indications from all
-- entities in the current scope and in any parent scopes if the current
-- scope is a block or a package (and that recursion continues to the
-- top scope that is not a block or a package). This is used when the
-- sequential flow-of-control assumption is violated (occurence of a
-- label, head of a loop, or start of an exception handler). The effect
-- of the call is to clear the Constant_Value field (but we do not need
-- to clear the Is_True_Constant flag, since that only gets reset if
-- there really is an assignment somewhere in the entity scope). This
-- procedure also calls Kill_All_Checks, since this is a special case
-- of needing to forget saved values. This procedure also clears any
-- Is_Known_Non_Null flags in variables, constants or parameters
-- since these are also not known to be valid.
-- scope is a block or a package (and that recursion continues to the top
-- scope that is not a block or a package). This is used when the
-- sequential flow-of-control assumption is violated (occurence of a label,
-- head of a loop, or start of an exception handler). The effect of the
-- call is to clear the Constant_Value field (but we do not need to clear
-- the Is_True_Constant flag, since that only gets reset if there really is
-- an assignment somewhere in the entity scope). This procedure also calls
-- Kill_All_Checks, since this is a special case of needing to forget saved
-- values. This procedure also clears Is_Known_Non_Null flags in variables,
-- constants or parameters since these are also not known to be valid.
procedure Kill_Current_Values (Ent : Entity_Id);
-- This performs the same processing as described above for the form with
......@@ -753,10 +774,27 @@ package Sem_Util is
-- direction. Cases which may possibly be assignments but are not known to
-- be may return True from May_Be_Lvalue, but False from this function.
procedure Mark_Static_Coextensions (Root_Node : Node_Id);
-- Perform a tree traversal starting from Root_Node while marking every
-- allocator as a static coextension. Cleanup for this action is performed
-- in Resolve_Allocator.
function Make_Simple_Return_Statement
(Sloc : Source_Ptr;
Expression : Node_Id := Empty) return Node_Id
renames Nmake.Make_Return_Statement;
-- See Sinfo. We rename Make_Return_Statement to the correct Ada 2005
-- terminology here. Clients should use Make_Simple_Return_Statement.
Make_Return_Statement : constant := -2 ** 33;
-- Attempt to prevent accidental uses of Make_Return_Statement. If this
-- and the one in Nmake are both potentially use-visible, it will cause
-- a compilation error. Note that type and value are irrelevant.
N_Return_Statement : constant := -2**33;
-- Attempt to prevent accidental uses of N_Return_Statement; similar to
-- Make_Return_Statement above.
procedure Mark_Coextensions (Context_Nod : Node_Id; Root_Nod : Node_Id);
-- Given a node which designates the context of analysis and an origin in
-- the tree, traverse from Root_Nod and mark all allocators as either
-- dynamic or static depending on Context_Nod. Any erroneous marking is
-- cleaned up during resolution.
function May_Be_Lvalue (N : Node_Id) return Boolean;
-- Determines if N could be an lvalue (e.g. an assignment left hand side).
......@@ -911,7 +949,15 @@ package Sem_Util is
-- capture actual value information, but we can capture conditional tests.
function Same_Name (N1, N2 : Node_Id) return Boolean;
-- Determine if two (possibly expanded) names are the same name
-- Determine if two (possibly expanded) names are the same name. This is
-- a purely syntactic test, and N1 and N2 need not be analyzed.
function Same_Object (Node1, Node2 : Node_Id) return Boolean;
-- Determine if Node1 and Node2 are known to designate the same object.
-- This is a semantic test and both nodesmust be fully analyzed. A result
-- of True is decisively correct. A result of False does not necessarily
-- mean that different objects are designated, just that this could not
-- be reliably determined at compile time.
function Same_Type (T1, T2 : Entity_Id) return Boolean;
-- Determines if T1 and T2 represent exactly the same type. Two types
......@@ -922,6 +968,13 @@ package Sem_Util is
-- False is indecisive (e.g. the compiler may not be able to tell that
-- two constraints are identical).
function Same_Value (Node1, Node2 : Node_Id) return Boolean;
-- Determines if Node1 and Node2 are known to be the same value, which is
-- true if they are both compile time known values and have the same value,
-- or if they are the same object (in the sense of function Same_Object).
-- A result of False does not necessarily mean they have different values,
-- just that it is not possible to determine they have the same value.
function Scope_Within_Or_Same (Scope1, Scope2 : Entity_Id) return Boolean;
-- Determines if the entity Scope1 is the same as Scope2, or if it is
-- inside it, where both entities represent scopes. Note that scopes
......
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