+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
-------------------------
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
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;
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
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);
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
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;
-- 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;
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))
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
-- 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
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
end if;
end;
end if;
+
return;
end if;