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 --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index bdadac6cc137f15f68ab634b4d125e9a60f66f7e..4e2bef32a353814cf929917eaee73ba0cea9e111 100644 (file)
--- 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 ce90f33aeda7e902c9afa9f106e976508544c513..c9040bf5ba017ec7d965855f5f8c5755eb65ca06 100644 (file)
--- 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 32eee3370e2680da0f9258ebef19907c1100b677..156afc923075219cdd454292846135e1b3fa7ef7 100644 (file)
--- 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 edb872f3d9761f396e60718e7bc8efca3680f49c..3a347efa4b5834feae3b53d85708e3162f7b804b 100644 (file)
--- 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