===================================================================
@@ -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
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.