From patchwork Thu Jan 3 11:13:13 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 209222 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 3E18E2C008F for ; Thu, 3 Jan 2013 22:14:01 +1100 (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=1357816441; 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=Lzjm/Zio7Nb159VZDkLs ppjyN7w=; b=vz8uZhP/9NF2Q14W5Ra49ewYGEgBCJIPc9RetbT7YAH7B0kvPuqU fbkTFwTyQZ5GO5xkvAZaKCMUl9aJIZBGSAfN0LJyI9i/wJIIW7wsEvyMrkyLXCW0 FtfYnS+TQ+sXDkcAQa9auwwJQW0X3NzWWpRqSTt2Pt9QyVRpAE9S8zc= 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=mGgKVAw9h4ULZZkLKC3maGE8YATHMHWNBkwta+evaoxe63L8TUJcssZJqUgXqL o1Cv0cm1AUlqEgm229Z1Fc3La67fpfh0SvqbLIJTnYeoGOmkHIjkNKpy0yeq6sRq bUIgl9+HtJL8F+PBvZU6C7nGyj4eq3zTBrDYly4a7tW0E=; Received: (qmail 9319 invoked by alias); 3 Jan 2013 11:13:26 -0000 Received: (qmail 9271 invoked by uid 22791); 3 Jan 2013 11:13:25 -0000 X-SWARE-Spam-Status: No, hits=-0.5 required=5.0 tests=AWL, BAYES_50, 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, 03 Jan 2013 11:13:14 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id CE31B1C64E8; Thu, 3 Jan 2013 06:13:13 -0500 (EST) 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 r6bljru461lA; Thu, 3 Jan 2013 06:13:13 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id AA4F61C64D4; Thu, 3 Jan 2013 06:13:13 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id A95433FF09; Thu, 3 Jan 2013 06:13:13 -0500 (EST) Date: Thu, 3 Jan 2013 06:13:13 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] Illegal component clause for inherited component in extension Message-ID: <20130103111313.GA27653@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 change fixes the circuitry that handles record representation clauses so that a component clause for an inherited component in a record extension is properly rejected (such a clause is illegal per 13.5.1(9)). The following compilation must be rejected with the indicated error: $ gcc -c illegal_clause_for_inherited_comp.ads illegal_clause_for_inherited_comp.ads:7:08: component clause not allowed for inherited component "B" package Illegal_Clause_For_Inherited_Comp is type R1 is tagged record B : Boolean; end record; type R1_Ext is new R1 with null record; for R1_Ext use record B at 2 range 63 .. 63; end record; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-01-03 Thomas Quinot * sem_ch13.adb (Analyze_Record_Representation_Clause): Reject an illegal component clause for an inherited component in a record extension. Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 194847) +++ sem_ch13.adb (working copy) @@ -4663,10 +4663,34 @@ Ocomp : Entity_Id; Posit : Uint; Rectype : Entity_Id; + Recdef : Node_Id; + function Is_Inherited (Comp : Entity_Id) return Boolean; + -- True if Comp is an inherited component in a record extension + + ------------------ + -- Is_Inherited -- + ------------------ + + function Is_Inherited (Comp : Entity_Id) return Boolean is + Comp_Base : Entity_Id; + begin + if Ekind (Rectype) = E_Record_Subtype then + Comp_Base := Original_Record_Component (Comp); + else + Comp_Base := Comp; + end if; + return Comp_Base /= Original_Record_Component (Comp_Base); + end Is_Inherited; + + Is_Record_Extension : Boolean; + -- True if Rectype is a record extension + CR_Pragma : Node_Id := Empty; -- Points to N_Pragma node if Complete_Representation pragma present + -- Start of processing for Analyze_Record_Representation_Clause + begin if Ignore_Rep_Clauses then return; @@ -4706,6 +4730,14 @@ return; end if; + -- We know we have a first subtype, now possibly go the the anonymous + -- base type to determine whether Rectype is a record extension. + + Recdef := Type_Definition (Declaration_Node (Base_Type (Rectype))); + Is_Record_Extension := + Nkind (Recdef) = N_Derived_Type_Definition + and then Present (Record_Extension_Part (Recdef)); + if Present (Mod_Clause (N)) then declare Loc : constant Source_Ptr := Sloc (N); @@ -4881,6 +4913,11 @@ ("cannot reference discriminant of unchecked union", Component_Name (CC)); + elsif Is_Record_Extension and then Is_Inherited (Comp) then + Error_Msg_NE + ("component clause not allowed for inherited " + & "component&", CC, Comp); + elsif Present (Component_Clause (Comp)) then -- Diagnose duplicate rep clause, or check consistency @@ -4908,10 +4945,11 @@ Error_Msg_N ("component clause inconsistent " & "with representation of ancestor", CC); + elsif Warn_On_Redundant_Constructs then Error_Msg_N - ("?r?redundant component clause " - & "for inherited component!", CC); + ("?r?redundant confirming component clause " + & "for component!", CC); end if; end; end if; @@ -7346,7 +7384,7 @@ begin if Present (CC1) and then Present (CC2) then - -- Exclude odd case where we have two tag fields in the same + -- Exclude odd case where we have two tag components in the same -- record, both at location zero. This seems a bit strange, but -- it seems to happen in some circumstances, perhaps on an error. @@ -7387,7 +7425,7 @@ procedure Find_Component is procedure Search_Component (R : Entity_Id); - -- Search components of R for a match. If found, Comp is set. + -- Search components of R for a match. If found, Comp is set ---------------------- -- Search_Component -- @@ -7426,8 +7464,8 @@ Search_Component (Rectype); - -- If not found, maybe component of base type that is absent from - -- statically constrained first subtype. + -- If not found, maybe component of base type discriminant that is + -- absent from statically constrained first subtype. if No (Comp) then Search_Component (Base_Type (Rectype)); @@ -7555,7 +7593,7 @@ ("bit number out of range of specified size", Last_Bit (CC)); - -- Check for overlap with tag field + -- Check for overlap with tag component else if Is_Tagged_Type (Rectype)