---------------------------------
procedure Warn_On_Overlapping_Actuals (Subp : Entity_Id; N : Node_Id) is
- function Is_Covered_Formal (Formal : Node_Id) return Boolean;
- -- Return True if Formal is covered by the rule
-
function Refer_Same_Object
(Act1 : Node_Id;
Act2 : Node_Id) return Boolean;
-- (RM 6.4.1(6.11/3))
-----------------------
- -- Is_Covered_Formal --
- -----------------------
-
- function Is_Covered_Formal (Formal : Node_Id) return Boolean is
- begin
- return
- Ekind_In (Formal, E_Out_Parameter, E_In_Out_Parameter)
- and then (Is_Elementary_Type (Etype (Formal))
- or else Is_Record_Type (Etype (Formal))
- or else Is_Array_Type (Etype (Formal)));
- end Is_Covered_Formal;
-
- -----------------------
-- Refer_Same_Object --
-----------------------
Form1 := First_Formal (Subp);
Act1 := First_Actual (N);
while Present (Form1) and then Present (Act1) loop
- if Is_Covered_Formal (Form1)
- or else not Is_Elementary_Type (Etype (Act1))
+ if Is_Generic_Type (Etype (Act1)) then
+ return;
+ end if;
+
+ -- One of the formals must be either (in)-out or composite.
+ -- The other must be (in)-out.
+
+ if Is_Elementary_Type (Etype (Act1))
+ and then Ekind (Form1) = E_In_Parameter
then
+ null;
+
+ else
Form2 := First_Formal (Subp);
Act2 := First_Actual (N);
while Present (Form2) and then Present (Act2) loop
if Form1 /= Form2
- and then Is_Covered_Formal (Form2)
and then Refer_Same_Object (Act1, Act2)
then
- -- Guard against previous errors
+ if Is_Generic_Type (Etype (Act2)) then
+ return;
+ end if;
- if Error_Posted (N)
- or else No (Etype (Act1))
- or else No (Etype (Act2))
- then
- null;
+ -- First case : two writable elementary parameters
+ -- that overlap.
- -- If the actual is a function call in prefix notation,
- -- there is no real overlap.
+ if (Is_Elementary_Type (Etype (Form1))
+ and then Is_Elementary_Type (Etype (Form2))
+ and then Ekind (Form1) /= E_In_Parameter
+ and then Ekind (Form2) /= E_In_Parameter)
- elsif Nkind (Act2) = N_Function_Call then
- null;
+ -- Second case : two composite parameters that overlap,
+ -- one of which is writable.
- -- If type is not by-copy, assume that aliasing is intended
+ or else (Is_Composite_Type (Etype (Form1))
+ and then Is_Composite_Type (Etype (Form2))
+ and then (Ekind (Form1) /= E_In_Parameter
+ or else Ekind (Form2) /= E_In_Parameter))
- elsif
- Present (Underlying_Type (Etype (Form1)))
- and then
- (Is_By_Reference_Type (Underlying_Type (Etype (Form1)))
- or else
- Convention (Underlying_Type (Etype (Form1))) =
- Convention_Ada_Pass_By_Reference)
- then
- null;
+ -- Third case : an elementary writable parameter that
+ -- overlaps a composite one.
- -- Under Ada 2012 we only report warnings on overlapping
- -- arrays and record types if switch is set.
+ or else (Is_Elementary_Type (Etype (Form1))
+ and then Ekind (Form1) /= E_In_Parameter
+ and then Is_Composite_Type (Etype (Form2)))
- elsif Ada_Version >= Ada_2012
- and then not Is_Elementary_Type (Etype (Form1))
- and then not Warn_On_Overlap
+ or else (Is_Elementary_Type (Etype (Form2))
+ and then Ekind (Form2) /= E_In_Parameter
+ and then Is_Composite_Type (Etype (Form1)))
then
- null;
- -- Here we may need to issue overlap message
+ -- Guard against previous errors
- else
- Error_Msg_Warn :=
+ if Error_Posted (N)
+ or else No (Etype (Act1))
+ or else No (Etype (Act2))
+ then
+ null;
- -- Overlap checking is an error only in Ada 2012. For
- -- earlier versions of Ada, this is a warning.
+ -- If the actual is a function call in prefix notation,
+ -- there is no real overlap.
- Ada_Version < Ada_2012
+ elsif Nkind (Act2) = N_Function_Call then
+ null;
- -- Overlap is only illegal in Ada 2012 in the case of
- -- elementary types (passed by copy). For other types,
- -- we always have a warning in all Ada versions.
+ -- If type is explicitly not by-copy, assume that
+ -- aliasing is intended.
+
+ elsif
+ Present (Underlying_Type (Etype (Form1)))
+ and then
+ (Is_By_Reference_Type
+ (Underlying_Type (Etype (Form1)))
+ or else
+ Convention (Underlying_Type (Etype (Form1))) =
+ Convention_Ada_Pass_By_Reference)
+ then
+ null;
- or else not Is_Elementary_Type (Etype (Form1))
+ -- Under Ada 2012 we only report warnings on overlapping
+ -- arrays and record types if switch is set.
- -- debug flag -gnatd.E changes the error to a warning
- -- even in Ada 2012 mode.
+ elsif Ada_Version >= Ada_2012
+ and then not Is_Elementary_Type (Etype (Form1))
+ and then not Warn_On_Overlap
+ then
+ null;
- or else Error_To_Warning
- or else Warn_Only;
+ -- Here we may need to issue overlap message
- declare
- Act : Node_Id;
- Form : Entity_Id;
+ else
+ Error_Msg_Warn :=
- begin
- -- Find matching actual
+ -- Overlap checking is an error only in Ada 2012.
+ -- For earlier versions of Ada, this is a warning.
- Act := First_Actual (N);
- Form := First_Formal (Subp);
- while Act /= Act2 loop
- Next_Formal (Form);
- Next_Actual (Act);
- end loop;
+ Ada_Version < Ada_2012
- if Is_Elementary_Type (Etype (Act1))
- and then Ekind (Form2) = E_In_Parameter
- then
- null; -- No real aliasing
+ -- Overlap is only illegal in Ada 2012 in the case
+ -- of elementary types (passed by copy). For other
+ -- types we always have a warning in all versions.
- elsif Is_Elementary_Type (Etype (Act2))
- and then Ekind (Form2) = E_In_Parameter
- then
- null; -- Ditto
+ or else not Is_Elementary_Type (Etype (Form1))
- -- If the call was written in prefix notation, and
- -- thus its prefix before rewriting was a selected
- -- component, count only visible actuals in the call.
+ -- debug flag -gnatd.E changes the error to a
+ -- warning even in Ada 2012 mode.
- elsif Is_Entity_Name (First_Actual (N))
- and then Nkind (Original_Node (N)) = Nkind (N)
- and then Nkind (Name (Original_Node (N))) =
- N_Selected_Component
- and then
- Is_Entity_Name (Prefix (Name (Original_Node (N))))
- and then
- Entity (Prefix (Name (Original_Node (N)))) =
- Entity (First_Actual (N))
- then
- if Act1 = First_Actual (N) then
- Error_Msg_FE
- ("<<`IN OUT` prefix overlaps with "
- & "actual for&", Act1, Form);
+ or else Error_To_Warning
+ or else Warn_Only;
+
+ declare
+ Act : Node_Id;
+ Form : Entity_Id;
+
+ begin
+ -- Find matching actual
+
+ Act := First_Actual (N);
+ Form := First_Formal (Subp);
+ while Act /= Act2 loop
+ Next_Formal (Form);
+ Next_Actual (Act);
+ end loop;
+
+ if Is_Elementary_Type (Etype (Act1))
+ and then Ekind (Form2) = E_In_Parameter
+ then
+ null; -- No real aliasing
+
+ elsif Is_Elementary_Type (Etype (Act2))
+ and then Ekind (Form2) = E_In_Parameter
+ then
+ null; -- Ditto
+
+ -- If the call was written in prefix notation, and
+ -- thus its prefix before rewriting was a selected
+ -- component, count only visible actuals in call.
+
+ elsif Is_Entity_Name (First_Actual (N))
+ and then Nkind (Original_Node (N)) = Nkind (N)
+ and then Nkind (Name (Original_Node (N))) =
+ N_Selected_Component
+ and then
+ Is_Entity_Name
+ (Prefix (Name (Original_Node (N))))
+ and then
+ Entity (Prefix (Name (Original_Node (N)))) =
+ Entity (First_Actual (N))
+ then
+ if Act1 = First_Actual (N) then
+ Error_Msg_FE
+ ("<<`IN OUT` prefix overlaps with "
+ & "actual for&", Act1, Form);
+
+ else
+ -- For greater clarity, give name of formal
+
+ Error_Msg_Node_2 := Form;
+ Error_Msg_FE
+ ("<<writable actual for & overlaps with "
+ & "actual for&", Act1, Form);
+ end if;
else
-- For greater clarity, give name of formal
Error_Msg_Node_2 := Form;
+
+ -- This is one of the messages
+
Error_Msg_FE
("<<writable actual for & overlaps with "
- & "actual for&", Act1, Form);
+ & "actual for&", Act1, Form1);
end if;
-
- else
- -- For greater clarity, give name of formal
-
- Error_Msg_Node_2 := Form;
-
- -- This is one of the messages
-
- Error_Msg_FE
- ("<<writable actual for & overlaps with "
- & "actual for&", Act1, Form1);
- end if;
- end;
+ end;
+ end if;
end if;
return;
projects / platform / upstream / gcc.git / commitdiff