From: Gary Dismukes <dismu...@adacore.com>
The initial implementation of the warning resulted in unwanted false
positives for types that have a user-defined equality function (in
which case abstract equality on components will typically not ever
be invoked). The conditions for reporting the warning are refined
by this change to exclude checking for presence of abstract component
equality functions in the case where the containing type has a user-defined
equality.
gcc/ada/ChangeLog:
* exp_ch4.adb (Expand_N_Op_Eq): Test for absence of user-defined
equality on type being compared (for both array and record types)
as a condition for checking for abstract equality on component
types. Add a "???" comment about current limitations on issuing
the new warning.
(Warn_On_Abstract_Equality_For_Component): Remove temporary disabling
of the warning. Improve comment on declaration.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch4.adb | 60 ++++++++++++++++++++++++++++++---------------
1 file changed, 40 insertions(+), 20 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 2ac5e797e512..23a59de6f872 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -8187,8 +8187,8 @@ package body Exp_Ch4 is
procedure Warn_On_Abstract_Equality_For_Component
(Comp_Type : Entity_Id);
- -- If Comp_Type has a user-defined abstract equality function, then
- -- issue a warning that Program_Error will be raised.
+ -- If Comp_Type is a record type with a user-defined abstract primitive
+ -- equality, then issue a warning that Program_Error will be raised.
-------------------------
-- Build_Equality_Call --
@@ -8423,13 +8423,6 @@ package body Exp_Ch4 is
is
Eq : Entity_Id;
begin
- -- Temporarily disable warning, to prevent spurious warnings
- -- occurring in vss-xml-implementation-html_writer_data.adb. ???
-
- if True then
- return;
- end if;
-
if Is_Record_Type (Underlying_Type (Comp_Type)) then
Eq := Get_User_Defined_Equality (Comp_Type);
@@ -8509,7 +8502,16 @@ package body Exp_Ch4 is
-- Array types
elsif Is_Array_Type (Typl) then
- Warn_On_Abstract_Equality_For_Component (Component_Type (Typl));
+
+ -- If the outer type doesn't have a user-defined equality operation,
+ -- check whether its component type has an abstract equality, and
+ -- warn if so. Such a component equality function will raise
+ -- Program_Error of objects of the outer type are compared using
+ -- predefined equality.
+
+ if not Present (Get_User_Defined_Equality (Typl)) then
+ Warn_On_Abstract_Equality_For_Component (Component_Type (Typl));
+ end if;
-- If we are doing full validity checking, and it is possible for the
-- array elements to be invalid then expand out array comparisons to
@@ -8580,17 +8582,35 @@ package body Exp_Ch4 is
elsif Is_Record_Type (Typl) then
- declare
- Comp : Entity_Id := First_Component (Typl);
- begin
- while Present (Comp) loop
- if Chars (Comp) /= Name_uParent then
- Warn_On_Abstract_Equality_For_Component (Etype (Comp));
- end if;
+ -- When outer type doesn't have a user-defined equality operation,
+ -- check whether any of its components' types have an abstract
+ -- equality, and warn if so. Such component equality functions will
+ -- raise Program_Error when objects of the outer type are compared
+ -- using predefined equality.
- Next_Component (Comp);
- end loop;
- end;
+ -- ??? Note that this warning is currently only issued in cases of
+ -- top-level components of the type and not for deeper subcomponents.
+ -- Those could be handled with more work, such as by adding a flag
+ -- on record type entities, but it's not clear that it would be
+ -- worth the effort. Another limitation is that the warning check
+ -- is not done for tagged types in some cases, because equality
+ -- comparisons for those can be changed to calls at an earlier point
+ -- during analysis and resolution, and do not reach this code (but in
+ -- many cases tagged equality comparisons do reach the code below).
+
+ if not Present (Get_User_Defined_Equality (Typl)) then
+ declare
+ Comp : Entity_Id := First_Component (Typl);
+ begin
+ while Present (Comp) loop
+ if Chars (Comp) /= Name_uParent then
+ Warn_On_Abstract_Equality_For_Component (Etype (Comp));
+ end if;
+
+ Next_Component (Comp);
+ end loop;
+ end;
+ end if;
-- For tagged types, use the primitive "="
--
2.43.0
