From patchwork Mon Apr 18 10:35:48 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 611650 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3qpPhD3bJgz9t3y for ; Mon, 18 Apr 2016 20:36:28 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=kpjE3/A6; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=Y6DW996eHlgNSQAyNpJ4MSDpswR0MGQjhZGjeScrlZ32H19XxY Y7WJ6AIWPXKKtEdeCxtpmq2+nvThpjmWZVibPd3OvhcUxNed6sy3L6FGMl3SqjzK G1GZaKpbtLa0ssrcC6X9GsXS9ddJd3O2ZGJL42QLk4mYkIxGXxc09wFRA= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=p+75fkF2xrOcp1tN0TGt9ZRiyVY=; b=kpjE3/A6NlFrdt+Qt+IB P40lfRGxOTkmrXB2lHiYU7q38InlY2NWMYaxWyscijstnGHEyvKrCoSubJJqJwm1 qIv0dVd1pVoj5+tD3f/N3duFBMfeVAgcWJW//SYPmpp4WWt77P2ODKWpZAQclZEC MAWB4/MPUTsdqZxmZ2LmFMg= Received: (qmail 11422 invoked by alias); 18 Apr 2016 10:36:01 -0000 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 Received: (qmail 11391 invoked by uid 89); 18 Apr 2016 10:36:00 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.8 required=5.0 tests=BAYES_50, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_NONE autolearn=no version=3.3.2 spammy=Components, D*adacore.com, Present, entity_id X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Mon, 18 Apr 2016 10:35:50 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 3A5031168E1; Mon, 18 Apr 2016 06:35:48 -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 7TEzBS4B6God; Mon, 18 Apr 2016 06:35:48 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 27DA511683B; Mon, 18 Apr 2016 06:35:48 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 240A417F; Mon, 18 Apr 2016 06:35:48 -0400 (EDT) Date: Mon, 18 Apr 2016 06:35:48 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Warning on (others => <>) that does not cover any components. Message-ID: <20160418103548.GA58969@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch adds a warning on a record aggregate that includes an association with a box, when all other components of the record have explicit associations in the aggregate. Compiling: gcc -c -gnatwr question.ads must yield: question.ads:13:53: warning: others choice is redundant question.ads:13:53: warning: previous choices cover all components question.ads:14:57: warning: others choice is redundant question.ads:14:57: warning: previous choices cover all components question.ads:14:72: warning: others choice is redundant question.ads:14:72: warning: previous choices cover all components question.ads:19:12: warning: "others" choice is redundant question.ads:19:12: warning: previous choices cover all values --- package Question is type Mon_Enum_T is (A, B); type Mon_Record_T is record Mon_Enum : Mon_Enum_T; end record; type nested is record this : Mon_Record_T; end record; Mon_Record : Mon_Record_T := (Mon_Enum=>A,others=><>); My_Nest : Nested := (THis => (Mon_Enum => A, others => <>), others => <>); function Ma_Fonction(Mon_Enum : in Mon_Enum_T) return Boolean is ((case Mon_Enum is when A | B => True, when others => False)); --line 14 end Question; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-04-18 Ed Schonberg * sem_aggr.adb (Resolve_Record_Aggregate): If Warn_On_Redundant_Constructs is enabled, report a redundant box association that does not cover any components, as it done for redundant others associations in case statements. Index: sem_aggr.adb =================================================================== --- sem_aggr.adb (revision 235093) +++ sem_aggr.adb (working copy) @@ -2972,14 +2972,20 @@ -- -- This variable is updated as a side effect of function Get_Value. + Box_Node : Node_Id; Is_Box_Present : Boolean := False; - Others_Box : Boolean := False; + Others_Box : Integer := 0; + -- Ada 2005 (AI-287): Variables used in case of default initialization -- to provide a functionality similar to Others_Etype. Box_Present -- indicates that the component takes its default initialization; - -- Others_Box indicates that at least one component takes its default - -- initialization. Similar to Others_Etype, they are also updated as a + -- Others_Box counts the number of components of the current aggregate + -- (which may be a sub-aggregate of a larger one) that are default- + -- initialized. A value of One indicates that an others_box is present. + -- Any larger value indicates that the others_box is not redundant. + -- These variables, similar to Others_Etype, are also updated as a -- side effect of function Get_Value. + -- Box_Node is used to place a warning on a redundant others_box. procedure Add_Association (Component : Entity_Id; @@ -3231,7 +3237,7 @@ -- checks when the default includes function calls. if Box_Present (Assoc) then - Others_Box := True; + Others_Box := Others_Box + 1; Is_Box_Present := True; if Expander_Active then @@ -3704,7 +3710,8 @@ -- any component. elsif Box_Present (Assoc) then - Others_Box := True; + Others_Box := 1; + Box_Node := Assoc; end if; else @@ -4439,7 +4446,8 @@ Comp_Elmt := First_Elmt (Components); while Present (Comp_Elmt) loop - if Ekind (Node (Comp_Elmt)) /= E_Discriminant + if + Ekind (Node (Comp_Elmt)) /= E_Discriminant then Process_Component (Node (Comp_Elmt)); end if; @@ -4585,9 +4593,14 @@ -- Ada 2005 (AI-287): others choice may have expression or box - if No (Others_Etype) and then not Others_Box then + if No (Others_Etype) and then Others_Box = 0 then Error_Msg_N ("OTHERS must represent at least one component", Selectr); + + elsif Others_Box = 1 and then Warn_On_Redundant_Constructs then + Error_Msg_N ("others choice is redundant?", Box_Node); + Error_Msg_N ("\previous choices cover all components?", + Box_Node); end if; exit Verification;