Patchwork [Ada] Warn on Ada 2012 set membership test duplicate element

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 4, 2012, 9:23 a.m.
Message ID <20121004092358.GA10539@adacore.com>
Download mbox | patch
Permalink /patch/189076/
State New
Headers show

Comments

Arnaud Charlet - Oct. 4, 2012, 9:23 a.m.
This patch adds a warning if a duplicate literal entry is found in
an Ada 2012 set membership, as shown by this example:

     1. pragma Ada_2012;
     2. package Dupset is
     3.    a : integer;
     4.    b : character;
     5.    c : boolean := a in 1 |
     6.                        2 |
     7.                        3 |
     8.                        1 |
                               |
        >>> warning: duplicate of value given at line 5

     9.                        5;
    10.    d : boolean := b in 'a' |
    11.                        'b' |
    12.                        'c' |
    13.                        'b';
                               |
        >>> warning: duplicate of value given at line 11

    14.
    15.    type Day is (Mon, Tue, Wed, Thu, Fri);
    16.    x : Day;
    17.    e : boolean := x in Mon | Tue |
    18.                        Wed | Mon;
                                     |
        >>> warning: duplicate of value given at line 17

    19. end;

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

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Resolve_Set_Membership): Warn on duplicates.

Patch

Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 192066)
+++ sem_res.adb	(working copy)
@@ -7685,10 +7685,11 @@ 
       ----------------------------
 
       procedure Resolve_Set_Membership is
-         Alt : Node_Id;
+         Alt  : Node_Id;
+         Ltyp : constant Entity_Id := Etype (L);
 
       begin
-         Resolve (L, Etype (L));
+         Resolve (L, Ltyp);
 
          Alt := First (Alternatives (N));
          while Present (Alt) loop
@@ -7699,11 +7700,51 @@ 
             if not Is_Entity_Name (Alt)
               or else not Is_Type (Entity (Alt))
             then
-               Resolve (Alt, Etype (L));
+               Resolve (Alt, Ltyp);
             end if;
 
             Next (Alt);
          end loop;
+
+         --  Check for duplicates for discrete case
+
+         if Is_Discrete_Type (Ltyp) then
+            declare
+               type Ent is record
+                  Alt : Node_Id;
+                  Val : Uint;
+               end record;
+
+               Alts  : array (0 .. List_Length (Alternatives (N))) of Ent;
+               Nalts : Nat;
+
+            begin
+               --  Loop checking duplicates. This is quadratic, but giant sets
+               --  are unlikely in this context so it's a reasonable choice.
+
+               Nalts := 0;
+               Alt := First (Alternatives (N));
+               while Present (Alt) loop
+                  if Is_Static_Expression (Alt)
+                    and then (Nkind_In (Alt, N_Integer_Literal,
+                                         N_Character_Literal)
+                               or else Nkind (Alt) in N_Has_Entity)
+                  then
+                     Nalts := Nalts + 1;
+                     Alts (Nalts) := (Alt, Expr_Value (Alt));
+
+                     for J in 1 .. Nalts - 1 loop
+                        if Alts (J).Val = Alts (Nalts).Val then
+                           Error_Msg_Sloc := Sloc (Alts (J).Alt);
+                           Error_Msg_N ("duplicate of value given#?", Alt);
+                        end if;
+                     end loop;
+                  end if;
+
+                  Alt := Next (Alt);
+               end loop;
+            end;
+         end if;
       end Resolve_Set_Membership;
 
    --  Start of processing for Resolve_Membership_Op