Commit 27cdc66a by Robert Dewar Committed by Arnaud Charlet

sem_warn.adb, [...]: Minor reformatting.

2009-10-27  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb, sem_util.adb, sem_util.ads: Minor reformatting. Add
	comments.

From-SVN: r153595
parent 76b84bf0
2009-10-27 Robert Dewar <dewar@adacore.com>
* sem_warn.adb, sem_util.adb, sem_util.ads: Minor reformatting. Add
comments.
2009-10-27 Robert Dewar <dewar@adacore.com>
* s-os_lib.ads, s-os_lib.adb, prj-err.adb, makeutl.adb: Minor
reformatting.
......
......@@ -2142,26 +2142,35 @@ package body Sem_Util is
-------------------------
function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean is
begin
-- If we have entity names, then must be same entity
if Is_Entity_Name (A1) then
if Is_Entity_Name (A2)then
return Entity (A1) = Entity (A2);
return Entity (A1) = Entity (A2);
else
return False;
end if;
-- No match if not same node kind
elsif Nkind (A1) /= Nkind (A2) then
return False;
-- For selected components, must have same prefix and selector
elsif Nkind (A1) = N_Selected_Component then
return Denotes_Same_Object (Prefix (A1), Prefix (A2))
and then
Entity (Selector_Name (A1)) = Entity (Selector_Name (A2));
-- For explicit dereferences, prefixes must be same
elsif Nkind (A1) = N_Explicit_Dereference then
return Denotes_Same_Object (Prefix (A1), Prefix (A2));
-- For indexed components, prefixes and all subscripts must be the same
elsif Nkind (A1) = N_Indexed_Component then
if Denotes_Same_Object (Prefix (A1), Prefix (A2)) then
declare
......@@ -2172,6 +2181,9 @@ package body Sem_Util is
Indx1 := First (Expressions (A1));
Indx2 := First (Expressions (A2));
while Present (Indx1) loop
-- Shouldn't we be checking that values are the same???
if not Denotes_Same_Object (Indx1, Indx2) then
return False;
end if;
......@@ -2186,6 +2198,8 @@ package body Sem_Util is
return False;
end if;
-- For slices, prefixes must match and bounds must match
elsif Nkind (A1) = N_Slice
and then Denotes_Same_Object (Prefix (A1), Prefix (A2))
then
......@@ -2196,14 +2210,17 @@ package body Sem_Util is
Get_Index_Bounds (Etype (A1), Lo1, Hi1);
Get_Index_Bounds (Etype (A2), Lo2, Hi2);
-- Check whether bounds are statically identical
-- No attempt to detect partial overlap of slices.
-- Check whether bounds are statically identical. There is no
-- attempt to detect partial overlap of slices.
-- What about an array and a slice of an array???
return Denotes_Same_Object (Lo1, Lo2)
and then Denotes_Same_Object (Hi1, Hi2);
end;
-- Literals will appear as indices.
-- Literals will appear as indices. Isn't this where we should check
-- Known_At_Compile_Time at least if we are generating warnings ???
elsif Nkind (A1) = N_Integer_Literal then
return Intval (A1) = Intval (A2);
......
......@@ -254,8 +254,11 @@ package Sem_Util is
function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean;
function Denotes_Same_Prefix (A1, A2 : Node_Id) return Boolean;
-- Functions to detect suspicious overlapping between actuals in a call,
-- when one of them is writable. The predicates are those proposed in
-- when one of them is writable. The predicates are those proposed in
-- AI05-0144, to detect dangerous order dependence in complex calls.
-- I would add a parameter Warn which enables more extensive testing of
-- cases as we find appropriate when we are only warning ??? Or perhaps
-- return an indication of (Error, Warn, OK) ???
function Denotes_Variable (N : Node_Id) return Boolean;
-- Returns True if node N denotes a single variable without parentheses
......
......@@ -3544,8 +3544,9 @@ package body Sem_Warn is
Form1, Form2 : Entity_Id;
begin
-- For now, treat this warning as an extension.
-- For now, treat this warning as an extension
-- Why not just define a new warning switch, you really don't want to
-- force this warning when using conditional expressions for example???
if not Extensions_Allowed then
return;
......@@ -3554,7 +3555,7 @@ package body Sem_Warn is
-- Exclude calls rewritten as enumeration literals
if not Nkind_In
(N, N_Function_Call, N_Procedure_Call_Statement)
(N, N_Function_Call, N_Procedure_Call_Statement)
then
return;
end if;
......@@ -3570,22 +3571,23 @@ package body Sem_Warn is
Form1 := First_Formal (Subp);
Act1 := First_Actual (N);
while Present (Form1) and then Present (Act1) loop
if Ekind (Form1) = E_In_Out_Parameter then
Form2 := First_Formal (Subp);
Act2 := First_Actual (N);
while Present (Form2) and then Present (Act2) loop
if Form1 /= Form2
and then Ekind (Form2) /= E_Out_Parameter
and then
(Denotes_Same_Object (Act1, Act2)
or else Denotes_Same_Prefix (Act1, Act2))
or else
Denotes_Same_Prefix (Act1, Act2))
then
-- Exclude generic types and guard against previous errors.
-- If either type is elementary the aliasing is harmless
-- If either type is elementary the aliasing is harmless.
-- I can't relate the comment about elementary to the
-- actual code below, which seems to be testing generic???
if Error_Posted (N)
or else No (Etype (Act1))
......@@ -3605,15 +3607,19 @@ package body Sem_Warn is
null;
elsif Is_Elementary_Type (Underlying_Type (Etype (Form1)))
or else
Is_Elementary_Type (Underlying_Type (Etype (Form2)))
or else
Is_Elementary_Type (Underlying_Type (Etype (Form2)))
then
null;
else
declare
Act : Node_Id;
Form : Entity_Id;
begin
-- Find matching actual
Act := First_Actual (N);
Form := First_Formal (Subp);
while Act /= Act2 loop
......@@ -3624,6 +3630,8 @@ package body Sem_Warn is
-- If the call was written in prefix notation, count
-- only the visible actuals in the call.
-- Why original_node calls below ???
if Is_Entity_Name (First_Actual (N))
and then Nkind (Original_Node (N)) = Nkind (N)
and then
......@@ -3641,8 +3649,8 @@ package body Sem_Warn is
Act1, Form);
else
Error_Msg_FE
("writable actual overlaps with actual for&?",
Act1, Form);
("writable actual overlaps with actual for&?",
Act1, Form);
end if;
else
......@@ -3652,6 +3660,7 @@ package body Sem_Warn is
end if;
end;
end if;
return;
end if;
......
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