From ba621931790224d5d4c060fa7bdaa5763c3202a2 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sun, 29 Mar 2020 15:42:31 +0200 Subject: [Ada] Use uniform type resolution for membership tests 2020-06-15 Eric Botcazou gcc/ada/ * sem_res.adb (Resolve_Set_Membership): Remove local variable. In the non-overloaded case, call Intersect_Types on the left operand and the first alternative to get the resolution type. But test the subtype of the left operand to give the warning. --- gcc/ada/sem_res.adb | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 0290c53d413..89d78518bd3 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9250,8 +9250,8 @@ package body Sem_Res is T : Entity_Id; procedure Resolve_Set_Membership; - -- Analysis has determined a unique type for the left operand. Use it to - -- resolve the disjuncts. + -- Analysis has determined a unique type for the left operand. Use it as + -- the basis to resolve the disjuncts. ---------------------------- -- Resolve_Set_Membership -- @@ -9259,18 +9259,17 @@ package body Sem_Res is procedure Resolve_Set_Membership is Alt : Node_Id; - Ltyp : Entity_Id; begin -- If the left operand is overloaded, find type compatible with not -- overloaded alternative of the right operand. + Alt := First (Alternatives (N)); if Is_Overloaded (L) then - Ltyp := Empty; - Alt := First (Alternatives (N)); + T := Empty; while Present (Alt) loop if not Is_Overloaded (Alt) then - Ltyp := Intersect_Types (L, Alt); + T := Intersect_Types (L, Alt); exit; else Next (Alt); @@ -9280,15 +9279,15 @@ package body Sem_Res is -- Unclear how to resolve expression if all alternatives are also -- overloaded. - if No (Ltyp) then + if No (T) then Error_Msg_N ("ambiguous expression", N); end if; else - Ltyp := Etype (L); + T := Intersect_Types (L, Alt); end if; - Resolve (L, Ltyp); + Resolve (L, T); Alt := First (Alternatives (N)); while Present (Alt) loop @@ -9299,7 +9298,7 @@ package body Sem_Res is if not Is_Entity_Name (Alt) or else not Is_Type (Entity (Alt)) then - Resolve (Alt, Ltyp); + Resolve (Alt, T); end if; Next (Alt); @@ -9307,7 +9306,7 @@ package body Sem_Res is -- Check for duplicates for discrete case - if Is_Discrete_Type (Ltyp) then + if Is_Discrete_Type (T) then declare type Ent is record Alt : Node_Id; @@ -9350,11 +9349,11 @@ package body Sem_Res is -- equality for the type. This may be confusing to users, and the -- following warning appears useful for the most common case. - if Is_Scalar_Type (Ltyp) - and then Present (Get_User_Defined_Eq (Ltyp)) + if Is_Scalar_Type (Etype (L)) + and then Present (Get_User_Defined_Eq (Etype (L))) then Error_Msg_NE - ("membership test on& uses predefined equality?", N, Ltyp); + ("membership test on& uses predefined equality?", N, Etype (L)); Error_Msg_N ("\even if user-defined equality exists (RM 4.5.2 (28.1/3)?", N); end if; -- cgit v1.2.3