https://gcc.gnu.org/g:369b7ed801ed73bf10bba3fc8a858d7102074475
commit r16-3715-g369b7ed801ed73bf10bba3fc8a858d7102074475
Author: Gary Dismukes <dismu...@adacore.com>
Date: Tue Aug 12 00:26:07 2025 +0000
ada: Warning for composite equality that calls an abstract equality function
When equality is tested for a composite type that has any record
components whose type has an abstract equality function that will
be called as part of the enclosing type's equality, Program_Error
will be raised. We now issue a warning on the equality test,
mentioning the component type whose abstract equality function
will trigger the exception. Note that this is currently only
done for top-level components of the composite type. Another
limitation is that the warning is not issued when the outer
composite type is tagged.
gcc/ada/ChangeLog:
* exp_ch4.adb (Expand_N_Op_Eq): Check for warning about call to
the abstract equality function of a component type, for both array
and record enclosing types.
(Warn_On_Abstract_Equality_For_Component): New procedure to issue
a warning when an abstract equality function of a component type
will be called and result in Program_Error.
Diff:
---
gcc/ada/exp_ch4.adb | 39 +++++++++++++++++++++++++++++++++++++++
1 file changed, 39 insertions(+)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index afdc243d302e..9c987a6fc436 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -8185,6 +8185,11 @@ package body Exp_Ch4 is
-- Determines whether a type has a subcomponent of an unconstrained
-- Unchecked_Union subtype. Typ is a record type.
+ 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.
+
-------------------------
-- Build_Equality_Call --
-------------------------
@@ -8409,6 +8414,27 @@ package body Exp_Ch4 is
Unconstrained_UU_In_Component_List (Optional_Component_List);
end Has_Unconstrained_UU_Component;
+ ---------------------------------------------
+ -- Warn_On_Abstract_Equality_For_Component --
+ ---------------------------------------------
+
+ procedure Warn_On_Abstract_Equality_For_Component
+ (Comp_Type : Entity_Id)
+ is
+ Eq : Entity_Id;
+ begin
+ if Is_Record_Type (Underlying_Type (Comp_Type)) then
+ Eq := Get_User_Defined_Equality (Comp_Type);
+
+ if Present (Eq) and then Is_Abstract_Subprogram (Eq) then
+ Error_Msg_Warn := SPARK_Mode /= On;
+ Error_Msg_NE ("call to abstract equality function of "
+ & "component type &<<", N, Comp_Type);
+ Error_Msg_N ("\Program_Error [<<", N);
+ end if;
+ end if;
+ end Warn_On_Abstract_Equality_For_Component;
+
-- Local variables
Typl : Entity_Id;
@@ -8476,6 +8502,7 @@ package body Exp_Ch4 is
-- Array types
elsif Is_Array_Type (Typl) then
+ Warn_On_Abstract_Equality_For_Component (Component_Type (Typl));
-- If we are doing full validity checking, and it is possible for the
-- array elements to be invalid then expand out array comparisons to
@@ -8546,6 +8573,18 @@ 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;
+
+ Next_Component (Comp);
+ end loop;
+ end;
+
-- For tagged types, use the primitive "="
if Is_Tagged_Type (Typl) then
