From patchwork Fri Sep 8 09:45:06 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 811426 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-461713-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="jFD99kIT"; 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 3xpXWN1fvgz9s7p for ; Fri, 8 Sep 2017 19:45:52 +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=nJCLm9/WrbEQBFZsw+EAmV+rDyKM9l07KR98EShgOPxOviVfXD 5/ipyEA1As2WfXXBUoOB01YsWjqltMHAmKfovIJ7CwxvOzko1WFm6mvHruXJTRNy lb58KNISw5wOWsxkSnarB6Ppg8r70W3Hw+ljPLU/ONjKlNwfU7CpcdH2w= 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=Kev5wVKjNT39PhP4Hld3Q5nS70o=; b=jFD99kITtLf4foZq7gzW +TBapzH1VOIuHu4EvusjZ0MdX4NfuJhDYLjrndiUYgZVPc689ct5TWOogosDdA7M xLB+7ySKQQn7UlVX1oyos7K1/a5na3nQvJNgWFPjGsFMIObMTOp9V08qA/v1zbry lQnUfTvMm5txBlLEtTgI9TI= Received: (qmail 14831 invoked by alias); 8 Sep 2017 09:45:28 -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 10970 invoked by uid 89); 8 Sep 2017 09:45:21 -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= 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; Fri, 08 Sep 2017 09:45:15 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5DED056260; Fri, 8 Sep 2017 05:45:06 -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 qQb3l4zjxXVC; Fri, 8 Sep 2017 05:45:06 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 4D46D5625A; Fri, 8 Sep 2017 05:45:06 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 4AAE6505; Fri, 8 Sep 2017 05:45:06 -0400 (EDT) Date: Fri, 8 Sep 2017 05:45:06 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Compiler crash on anonymous array with component with invariant Message-ID: <20170908094506.GA59669@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch fixes a compiler abort on an object declaration with an anonymous array when the component type of the array has an invariant aspect. The following must compile quietly: gcc -c -gnata main.adb with Lrs; procedure Main is begin Lrs.Initialise; end Main; --- with Global; package Lrs is type Quadrant_Specification is private; procedure Initialise; private type Quadrant_Specification is record N_Klingons: Global.Klingon_Counter := 0; Has_Starbase: Boolean := False; N_Stars: Global.Local_Star_Counter := 0; Is_Scanned: Boolean := False; end record with Type_Invariant => N_Klingons <= Global.MAX_LOCAL_KLINGONS; Quadrant_Specifications: array(Global.Quadrant_X_Index'Range, Global.Quadrant_Y_Index'Range) of Quadrant_Specification; end Lrs; --- package Global is MAX_KLINGONS: constant := 20; -- The maximum number of Klingons in the universe MAX_LOCAL_KLINGONS: constant := 3; -- The maximum number of Klingons in a quadrant MAX_LOCAL_STARS: constant := 8; -- The maximum number of stars in a quadrant UNIVERSE_SIZE: constant := 8; -- The X and Y size of the universe, in quadrants subtype Klingon_Counter is Integer range 0..MAX_KLINGONS; -- Type for the number of Klingons subtype Local_Star_Counter is Integer range 0..MAX_LOCAL_STARS; -- Type for the number of stars in a quadrant subtype Quadrant_X_Index is Integer range 1..UNIVERSE_SIZE; -- Subtype for quadrant X-indexes subtype Quadrant_Y_Index is Integer range 1..UNIVERSE_SIZE; -- Subtype for quadrant Y-indexes end Global; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-08 Ed Schonberg * exp_util.adb (Build_Invariant_Procedure_Declaration): If the type is an anonymous array in an object declaration, whose component type has an invariant, use the object declaration as the insertion point for the invariant procedure, given that there is no explicit type declaration for an anonymous array type. Index: exp_util.adb =================================================================== --- exp_util.adb (revision 251863) +++ exp_util.adb (working copy) @@ -3408,7 +3408,12 @@ -- Derived types with the full view as parent do not have a partial -- view. Insert the invariant procedure after the derived type. + -- Anonymous arrays in object declarations have no explicit declaration + -- so use the related object declaration as the insertion point. + elsif Is_Itype (Work_Typ) and then Is_Array_Type (Work_Typ) then + Typ_Decl := Associated_Node_For_Itype (Work_Typ); + else Typ_Decl := Declaration_Node (Full_Typ); end if;