https://gcc.gnu.org/g:31c95bb248c923e926102dd363cff0d9e1e5083d
commit r17-4578-g31c95bb248c923e926102dd363cff0d9e1e5083d Author: Eric Botcazou <[email protected]> Date: Tue Sep 22 21:14:31 2026 +0200 Ada: Fix valid call to asymmetric "/=" rejected in prefix notation This happens only when one of the operands is of a tagged type, because the handling of equality operators for tagged types is completely separate from that of equality operators for untagged types. But it turns out that this separate processing is intended to be used for symmetric equality operators only, so the fix is to redirect that of all asymmetric equality operators to the common processing instead. This also fixes a small glitch in this common processing, whereby a derived type would both inherit an implicit inequality operator from its parent type per the RM 6.6(6) rule and have another implicit inequality operator created from an equality operator inherited from its parent type. gcc/ada/ * exp_ch3.adb (Make_Predefined_Primitive_Eq_Spec): Fix pasto. * sem_ch4.adb (wpo): Also accept untagged types. * sem_ch6.adb (Make_Inequality_Operator): Also copy Is_Primitive. (New_Overloaded_Entity): Create the implicit inequality operator only for nonderived subprograms, but create it in the asymmetric case even for tagged types. Deal with the inheritance of such an implicit inequality operator. * sem_disp.adb: Add clauses for Stand. (Check_Dispatching_Operation): Bail out for inequality operators whose result type is Boolean. Diff: --- gcc/ada/exp_ch3.adb | 2 +- gcc/ada/sem_ch4.adb | 4 ---- gcc/ada/sem_ch6.adb | 62 +++++++++++++++++++++++++++++++++++++++++++--------- gcc/ada/sem_disp.adb | 13 ++++++++++- 4 files changed, 65 insertions(+), 16 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index c57949eb425b..5f4a271d627e 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -12351,7 +12351,7 @@ package body Exp_Ch3 is -- Set to True if Tag_Typ has a primitive that renames the predefined -- equality operator. Used to implement (RM 8-5-4(8)). - -- Start of processing for Make_Predefined_Primitive_Specs + -- Start of processing for Make_Predefined_Primitive_Eq_Spec begin Renamed_Eq := Empty; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 400fa4f8869f..31786fd6ab76 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -11440,10 +11440,6 @@ package body Sem_Ch4 is E : Elmt_Id; begin - if not Is_Tagged_Type (T) then - return; - end if; - E := First_Elmt (Primitive_Operations (Base_Type (T))); while Present (E) loop Op := Node (E); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 2ed3b7c3f477..76da204abcf4 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -11656,6 +11656,7 @@ package body Sem_Ch6 is Set_Has_Completion (Op_Name); Set_Corresponding_Equality (Op_Name, S); Set_Is_Abstract_Subprogram (Op_Name, Is_Abstract_Subprogram (S)); + Set_Is_Primitive (Op_Name, Is_Primitive (S)); end; end Make_Inequality_Operator; @@ -13274,23 +13275,22 @@ package body Sem_Ch6 is -- operation was dispatching), so Check_Dispatching_Operation is not -- called in that case. - if No (Derived_Type) - or else Is_Tagged_Type (Derived_Type) - then + if No (Derived_Type) or else Is_Tagged_Type (Derived_Type) then Check_Dispatching_Operation (S, Empty); end if; end if; - -- If this is a user-defined equality operator that is not a derived - -- subprogram, create the corresponding inequality. If the operation is - -- dispatching, the expansion is done elsewhere, and we do not create - -- an explicit inequality operation. - <<Check_Inequality>> + -- If this is an equality operator whose result type is Boolean and + -- that is not a derived subprogram, create the implicit inequality + -- operator (RM 6.6(6)), but not if it is a dispatching user-defined + -- equality operator because those are handled specially. + if Chars (S) = Name_Op_Eq and then Base_Type (Etype (S)) = Standard_Boolean - and then Present (Parent (S)) - and then not Is_Dispatching_Operation (S) + and then No (Alias (S)) + and then not (Is_Dispatching_Operation (S) + and then Is_User_Defined_Equality (S)) then Make_Inequality_Operator (S); @@ -13302,6 +13302,48 @@ package body Sem_Ch6 is then Check_Untagged_Equality (S); end if; + + -- If this is an inherited implicit inequality operator, set its + -- Corresponding_Equality to the inherited equality operator. + + elsif Chars (S) = Name_Op_Ne + and then Base_Type (Etype (S)) = Standard_Boolean + and then Present (Alias (S)) + and then Present (Corresponding_Equality (Alias (S))) + then + declare + Eq : constant Entity_Id := Prev_Entity (S); + + function Check_Correspondence return Boolean; + -- Check that the Corresponding_Equality of the immediate + -- ancestor of S is an ancestor of Eq. Note that we cannot + -- be more specific for Eq since Sem_Ch3.Derive_Subprogram + -- does not set the Alias field of derived subprograms the + -- same way for intrinsic and nonintrinsic subprograms. + + -------------------------- + -- Check_Correspondence -- + -------------------------- + + function Check_Correspondence return Boolean is + A : Entity_Id := Alias (Eq); + + begin + while Present (A) loop + if Corresponding_Equality (Alias (S)) = A then + return True; + end if; + + A := Alias (A); + end loop; + + return False; + end Check_Correspondence; + + begin + pragma Assert (Check_Correspondence); + Set_Corresponding_Equality (S, Eq); + end; end if; end New_Overloaded_Entity; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index c093d1122d0e..cf12321cc5cd 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -53,6 +53,7 @@ with Sem_Util; use Sem_Util; with Snames; use Snames; with Sinfo.Nodes; use Sinfo.Nodes; with Sinfo.Utils; use Sinfo.Utils; +with Stand; use Stand; with Tbuild; use Tbuild; with Uintp; use Uintp; with Warnsw; use Warnsw; @@ -1286,10 +1287,20 @@ package body Sem_Disp is then return; - -- Wrappers of access to subprograms are not primitive subprograms. + -- Wrappers of access to subprograms are not dispatching operations elsif Is_Access_To_Subprogram_Wrapper (Subp) then return; + + -- Inequality operators whose result type is Boolean are not dispatching + -- operations because they are always implicitly declared as giving the + -- complementary result of the sibling equality operator (RM 6.6(5-6)). + + elsif Ekind (Subp) = E_Function + and then Chars (Subp) = Name_Op_Ne + and then Base_Type (Etype (Subp)) = Standard_Boolean + then + return; end if; Set_Is_Dispatching_Operation (Subp, False);
