[Ada] Added warning on membership tests

Message ID 20171215141240.GA97969@adacore.com
State New
Headers show
  • [Ada] Added warning on membership tests
Related show

Commit Message

Pierre-Marie de Rodat Dec. 15, 2017, 2:12 p.m.
RM 4.5.3 (28) specifies that (except for records and limited types) a
membership operation uses the predefined equality, regardless of whether
user-defined equality for the type is available. This can be confusing
and deserves a new warning.

Compiling code.adb must yield:

  code.adb:19:42: warning: membership test on "Var" uses predefined equality
  code.adb:19:42: warning: even if user-defined equality exists
      (RM 4.5.2 (28.1/3)

with Ada.Characters.Handling;
with Ada.Text_IO; use Ada.Text_IO;
procedure Code is
   type Var is new Character;

   function "=" (C1, C2 : Var) return Boolean;

   function "=" (C1, C2 : Var) return Boolean is
      use Ada.Characters.Handling;
      return To_Lower (Character (C1)) = To_Lower (Character (C2));
   end "=";

   V : Var := 'A';

   Put_Line ("equal " & Boolean'Image (V = 'a'));

   Put_Line ("in    " & Boolean'Image (V in 'a' | 'o'));
end Code;

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-12-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Membership_Op): Add warning on a membership
	operation on a scalar type for which there is a user-defined equality


Index: sem_res.adb
--- sem_res.adb	(revision 255694)
+++ sem_res.adb	(working copy)
@@ -9086,6 +9086,21 @@ 
                end loop;
          end if;
+         --  RM 4.5.2 (28.1/3) specifies that for types other than records or
+         --  limited types, evaluation of a membership test uses the predefined
+         --  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))
+         then
+            Error_Msg_NE
+              ("membership test on& uses predefined equality?", N, Ltyp);
+            Error_Msg_N
+              ("\even if user-defined equality exists (RM 4.5.2 (28.1/3)?", N);
+         end if;
       end Resolve_Set_Membership;
    --  Start of processing for Resolve_Membership_Op