https://gcc.gnu.org/g:f1c22e6ea6e384ad07cb94dc20595de3e2b59e1d
commit r16-1876-gf1c22e6ea6e384ad07cb94dc20595de3e2b59e1d
Author: Javier Miranda <mira...@adacore.com>
Date: Fri May 16 17:59:43 2025 +0000
ada: Warn on untagged record type equality
The frontend reports a warning when no component of an untagged
record type U is a record type, and the type C of some of its
components has defined its user-defined equality operator "=".
The warning is reported because it may be surprising that, following
RM 4.5.2 (24/3), the predefined "=" of the component type C takes
precedence over its user-defined "=" when objects of the record
type R are compared.
gcc/ada/ChangeLog:
* exp_ch3.adb (Build_Untagged_Record_Equality): Report the
warning when no component of an untagged record type U is a
record type, and the type C of some of its components has
defined its user-defined equality operator "=".
* exp_ch4.adb (Expand_Composite_Equality): Report the warning
calling Warn_On_Ignored_Equality_Operator.
* sem_warn.ads (Warn_On_Ignored_Equality_Operator): New subprogram.
* sem_warn.adb (Warn_On_Ignored_Equality_Operator): Factorize code
reporting the warning.
Diff:
---
gcc/ada/exp_ch3.adb | 28 ++++++++++++++++++++++++++++
gcc/ada/exp_ch4.adb | 15 +++++++--------
gcc/ada/sem_warn.adb | 18 ++++++++++++++++++
gcc/ada/sem_warn.ads | 9 +++++++++
4 files changed, 62 insertions(+), 8 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index bdadac6cc137..4e2bef32a353 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -69,6 +69,7 @@ with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
+with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
@@ -77,6 +78,7 @@ with Snames; use Snames;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Validsw; use Validsw;
+with Warnsw; use Warnsw;
package body Exp_Ch3 is
@@ -5157,6 +5159,32 @@ package body Exp_Ch3 is
if Is_Library_Level_Entity (Typ) then
Set_Is_Public (Op);
end if;
+
+ -- Otherwise, the result is defined in terms of the primitive equals
+ -- operator (RM 4.5.2 (24/3)). Report a warning if some component of
+ -- the untagged record has defined a user-defined "=", because it can
+ -- be surprising that the predefined "=" takes precedence over it.
+ -- This warning is not reported when Build_Eq is True because the
+ -- expansion of the built body will call Expand_Composite_Equality
+ -- that will report it if necessary.
+
+ elsif Warn_On_Ignored_Equality then
+ Comp := First_Component (Typ);
+
+ while Present (Comp) loop
+ if Present (User_Defined_Eq (Etype (Comp)))
+ and then not Is_Record_Type (Etype (Comp))
+ and then not Is_Intrinsic_Subprogram
+ (User_Defined_Eq (Etype (Comp)))
+ then
+ Warn_On_Ignored_Equality_Operator
+ (Typ => Typ,
+ Comp_Typ => Etype (Comp),
+ Loc => Sloc (User_Defined_Eq (Etype (Comp))));
+ end if;
+
+ Next_Component (Comp);
+ end loop;
end if;
end Build_Untagged_Record_Equality;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index ce90f33aeda7..c9040bf5ba01 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2470,21 +2470,20 @@ package body Exp_Ch4 is
declare
Op : constant Entity_Id := Find_Primitive_Eq (Comp_Type);
+
begin
- if Warn_On_Ignored_Equality
- and then Present (Op)
+ if Present (Op)
and then not In_Predefined_Unit (Base_Type (Comp_Type))
and then not Is_Intrinsic_Subprogram (Op)
then
pragma Assert
(Is_First_Subtype (Outer_Type)
or else Is_Generic_Actual_Type (Outer_Type));
- Error_Msg_Node_2 := Comp_Type;
- Error_Msg_N
- ("?_q?""="" for type & uses predefined ""="" for }",
- Outer_Type);
- Error_Msg_Sloc := Sloc (Op);
- Error_Msg_N ("\?_q?""="" # is ignored here", Outer_Type);
+
+ Warn_On_Ignored_Equality_Operator
+ (Typ => Outer_Type,
+ Comp_Typ => Comp_Type,
+ Loc => Sloc (Op));
end if;
end;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 32eee3370e26..156afc923075 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3464,6 +3464,24 @@ package body Sem_Warn is
end if;
end Warn_On_Constant_Valid_Condition;
+ ---------------------------------------
+ -- Warn_On_Ignored_Equality_Operator --
+ ---------------------------------------
+
+ procedure Warn_On_Ignored_Equality_Operator
+ (Typ : Entity_Id;
+ Comp_Typ : Entity_Id;
+ Loc : Source_Ptr) is
+ begin
+ if Warn_On_Ignored_Equality then
+ Error_Msg_Node_2 := Comp_Typ;
+ Error_Msg_N ("?_q?""="" for type & uses predefined ""="" for }", Typ);
+
+ Error_Msg_Sloc := Loc;
+ Error_Msg_N ("\?_q?""="" # is ignored here", Typ);
+ end if;
+ end Warn_On_Ignored_Equality_Operator;
+
-----------------------------
-- Warn_On_Known_Condition --
-----------------------------
diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads
index edb872f3d976..3a347efa4b58 100644
--- a/gcc/ada/sem_warn.ads
+++ b/gcc/ada/sem_warn.ads
@@ -173,6 +173,15 @@ package Sem_Warn is
-- Op assuming that its scalar operands are valid. Emit a warning when the
-- result of the evaluation is True or False.
+ procedure Warn_On_Ignored_Equality_Operator
+ (Typ : Entity_Id;
+ Comp_Typ : Entity_Id;
+ Loc : Source_Ptr);
+ -- Typ is a composite type and Comp_Typ is the type of one of its
+ -- components. Output a warning notifying that the predefined "="
+ -- for Comp_Typ takes precedence over the user-defined equality
+ -- defined at the given location.
+
procedure Warn_On_Known_Condition (C : Node_Id);
-- C is a node for a boolean expression resulting from a relational
-- or membership operation. If the expression has a compile time known
