ada: Warn on untagged record type equality under Ada 83/95 modes

Compiling under Ada 83 or Ada 95 mode, the warning reported under
-gnatw_q is triggered by the compiler when a user-defined "=" on
an untagged record type U is not used to compare a component C
(of type U) of an outer record R.

The warning is reported because it may be surprising that, under
Ada 83 and Ada 95 modes, 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_ch4.adb (Expand_Composite_Equality): Under Ada83 and Ada95
	modes, and compiling under -gnatw_q, search for an user-defined
	equality and report a warning if found since it will not be called.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 28d7f59677746d78613135ea539632c42d7df365..d4bc4ba21edca0389bb28e507aa5219f0b22186b 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2459,7 +2459,34 @@ package body Exp_Ch4 is
                    Parameter_Associations => New_List (L_Exp, R_Exp));
             end;
 
+         --  Composite equality not available for the type
+
          else
+            --  Under Ada83 and Ada95, search for user-defined equality and
+            --  report a warning if found since it will not be called.
+
+            if Ada_Version <= Ada_95
+              and then Warn_On_Ignored_Equality
+            then
+               declare
+                  Elmt : Elmt_Id;
+
+               begin
+                  Elmt := First_Elmt (Direct_Primitive_Operations (Full_Type));
+                  while Present (Elmt) loop
+                     if Is_User_Defined_Equality (Node (Elmt)) then
+                        Warn_On_Ignored_Equality_Operator
+                          (Typ      => Outer_Type,
+                           Comp_Typ => Full_Type,
+                           Loc      => Sloc (Node (Elmt)));
+                        exit;
+                     end if;
+
+                     Next_Elmt (Elmt);
+                  end loop;
+               end;
+            end if;
+
             return Expand_Record_Equality (Nod, Full_Type, Lhs, Rhs);
          end if;