From patchwork Thu Oct 4 09:23:58 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 189076 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id CA47E2C035C for ; Thu, 4 Oct 2012 19:24:17 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1349947458; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=P8z6aYb6Cf9Ppa5Hrh8S n3WJLC8=; b=UbTaJKidPLW+XQXaUMd1QHGbCPuvbITThKSbMcYAeRNMCrp0tNFu E3llF7u33z3zjej6qCAUBT8FGFCYtaUUCYZYJJwcqHe6GcVoJHBEfaqPaJst5FCE RLSwYoPtA1HW3HSeenfFfHhJ/A2T/wwdOzsw+wt9ibvIIZDrO+Usi0Q= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=Y59jQTzjOo1M+OV17hW8nU+M6puv4II6Y/G+gp17EAHiRVF8QQxXfnlm3AWLWV RFF6/OyA4Lz62vo4cbiKOCxrjiv8ZSDMrCKLx7xROv7Hs+gRaYhOOS2+yGjL42+M xdRNlyoB3eeW5hHX2KPEwfVhdU2h6o+oL8NlANKXwSJ8s=; Received: (qmail 27034 invoked by alias); 4 Oct 2012 09:24:07 -0000 Received: (qmail 27018 invoked by uid 22791); 4 Oct 2012 09:24:04 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 04 Oct 2012 09:24:00 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 31EF81C7D70; Thu, 4 Oct 2012 05:24:00 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id aR1wxIeBeMNb; Thu, 4 Oct 2012 05:24:00 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 901A61C7E3F; Thu, 4 Oct 2012 05:23:58 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 8BEFF919E3; Thu, 4 Oct 2012 05:23:58 -0400 (EDT) Date: Thu, 4 Oct 2012 05:23:58 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Warn on Ada 2012 set membership test duplicate element Message-ID: <20121004092358.GA10539@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * sem_res.adb (Resolve_Set_Membership): Warn on duplicates. 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