[gcc r16-6616] ada: Warn on untagged record type equality under Ada 83/95 modes

[Marc Poulhies]

https://gcc.gnu.org/g:76253776787099a656028cd7288f2e1b2a84e4d4

commit r16-6616-g76253776787099a656028cd7288f2e1b2a84e4d4
Author: Javier Miranda <miranda@adacore.com>
Date:   Wed Dec 10 12:08:32 2025 +0000

    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:
---
 gcc/ada/exp_ch4.adb | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 28d7f5967774..d4bc4ba21edc 100644
--- 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;