From patchwork Wed Sep 6 12:16:55 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 810562 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-461595-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ZLe5VPsj"; dkim-atps=neutral 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 3xnMyw0Jl7z9sBZ for ; Wed, 6 Sep 2017 22:17:11 +1000 (AEST) 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=HrR13Ms+kBkdqZ4C1Gnh9Z7K7Iw9h+S66ATs8Pc85P0DyApcCi sl7DIse4vrLJ83BinwnyXI5cJGIf/PC2hUMmWirLTDA5qHLOazWoa4JEQKbFsoOH x8t6FuVnPdoygJEPai4TYTEGNqWxfsLOFStOi44kZnShk/arQzZOK918o= 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=Rj6lmkBd+FCjMPWAWb9FBOIYfM0=; b=ZLe5VPsjtKHFLHTEqBPI Iy3DaT9sM6ia1BAksjVuTrYdjMIsYNexKuxiWF4Jw6vC8XlDkfk7nB9icG5UZrgo ZGM+LNxlWukaYH4F0rjNDOI2OjXVE5SmvPQo/uVVNpQ9heT8I6SIHJNCSTcZh1v+ agK2zT5t7p/RRtug/5wH3Fk= Received: (qmail 99225 invoked by alias); 6 Sep 2017 12:16:59 -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 99001 invoked by uid 89); 6 Sep 2017 12:16:58 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Comp, comp 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 ESMTP; Wed, 06 Sep 2017 12:16:57 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id A23105641C; Wed, 6 Sep 2017 08:16:55 -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 K48UX4B-rs1M; Wed, 6 Sep 2017 08:16:55 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 46F125614C; Wed, 6 Sep 2017 08:16:55 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 45FB54AC; Wed, 6 Sep 2017 08:16:55 -0400 (EDT) Date: Wed, 6 Sep 2017 08:16:55 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Issue error message on invalid representation clause for extension Message-ID: <20170906121655.GA59280@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This makes the compiler generate an error message also in the case where one of the specified components overlaps the parent field because its size has been explicitly set by a size clause. The compiler must issue an error on 32-bit platforms for the package: 1. package P is 2. 3. type Byte is mod 2**8; 4. for Byte'Size use 8; 5. 6. type Root is tagged record 7. Status : Byte; 8. end record; 9. for Root use record 10. Status at 4 range 0 .. 7; 11. end record; 12. for Root'Size use 64; 13. 14. type Ext is new Root with record 15. Thread_Status : Byte; 16. end record; 17. for Ext use record 18. Thread_Status at 5 range 0 .. 7; | >>> component overlaps parent field of "Ext" 19. end record; 20. 21. end P; 21 lines: 1 error Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-06 Eric Botcazou * sem_ch13.adb (Check_Record_Representation_Clause): Give an error as soon as one of the specified components overlaps the parent field. Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 251784) +++ sem_ch13.adb (working copy) @@ -9806,12 +9806,12 @@ -- checking for overlap, since no overlap is possible. Tagged_Parent : Entity_Id := Empty; - -- This is set in the case of a derived tagged type for which we have - -- Is_Fully_Repped_Tagged_Type True (indicating that all components are - -- positioned by record representation clauses). In this case we must - -- check for overlap between components of this tagged type, and the - -- components of its parent. Tagged_Parent will point to this parent - -- type. For all other cases Tagged_Parent is left set to Empty. + -- This is set in the case of an extension for which we have either a + -- size clause or Is_Fully_Repped_Tagged_Type True (indicating that all + -- components are positioned by record representation clauses) on the + -- parent type. In this case we check for overlap between components of + -- this tagged type and the parent component. Tagged_Parent will point + -- to this parent type. For all other cases, Tagged_Parent is Empty. Parent_Last_Bit : Uint; -- Relevant only if Tagged_Parent is set, Parent_Last_Bit indicates the @@ -9959,19 +9959,23 @@ if Rectype = Any_Type then return; - else - Rectype := Underlying_Type (Rectype); end if; + Rectype := Underlying_Type (Rectype); + -- See if we have a fully repped derived tagged type declare PS : constant Entity_Id := Parent_Subtype (Rectype); begin - if Present (PS) and then Is_Fully_Repped_Tagged_Type (PS) then + if Present (PS) and then Known_Static_RM_Size (PS) then Tagged_Parent := PS; + Parent_Last_Bit := RM_Size (PS) - 1; + elsif Present (PS) and then Is_Fully_Repped_Tagged_Type (PS) then + Tagged_Parent := PS; + -- Find maximum bit of any component of the parent type Parent_Last_Bit := UI_From_Int (System_Address_Size - 1); @@ -10063,7 +10067,7 @@ ("bit number out of range of specified size", Last_Bit (CC)); - -- Check for overlap with tag component + -- Check for overlap with tag or parent component else if Is_Tagged_Type (Rectype) @@ -10073,27 +10077,20 @@ ("component overlaps tag field of&", Component_Name (CC), Rectype); Overlap_Detected := True; + + elsif Present (Tagged_Parent) + and then Fbit <= Parent_Last_Bit + then + Error_Msg_NE + ("component overlaps parent field of&", + Component_Name (CC), Rectype); + Overlap_Detected := True; end if; if Hbit < Lbit then Hbit := Lbit; end if; end if; - - -- Check parent overlap if component might overlap parent field - - if Present (Tagged_Parent) and then Fbit <= Parent_Last_Bit then - Pcomp := First_Component_Or_Discriminant (Tagged_Parent); - while Present (Pcomp) loop - if not Is_Tag (Pcomp) - and then Chars (Pcomp) /= Name_uParent - then - Check_Component_Overlap (Comp, Pcomp); - end if; - - Next_Component_Or_Discriminant (Pcomp); - end loop; - end if; end if; Next (CC);