From patchwork Tue Aug 20 09:51:30 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1150004 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-507359-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="lP1Oe9M7"; 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 46CR4G3Nd8z9s4Y for ; Tue, 20 Aug 2019 19:55:26 +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=UOMSRAZmS3AuUNkDQrdihKxaR7oOTuS8bjEyWqe1DYWwZJ4S2v Nl8MMXkNZsUAZ6Hq1dlUHGMXOVyrGyFsMoQjUwI7Y4w5lAGLI/O40ke9E5oXIcIr 0nUjRAEytDkaCstYWw9li4j4d/DRmQ9jjY+00AtObb3rM3PFpppXPlMCU= 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=gcY0a0P2pdOFHgqCSuTpxr9MrbM=; b=lP1Oe9M7bWUMQ0FEPaQf LPOVSr3wOCCn4LyYmXk9WaFCbP1GiTaln0TCqr4ZSijNYXllL9vnP7Xid4JlT2ZT GIGEl7wDJ8YMRD/VE3/LgTRrOHnbSvEIL/UOd2hDkSlafhN6wwKEbgO3bqKuadBS okpVozuG1K2nFFesrI8JDMM= Received: (qmail 125014 invoked by alias); 20 Aug 2019 09:51:54 -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 122593 invoked by uid 89); 20 Aug 2019 09:51:35 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.1 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, SPF_NEUTRAL autolearn=ham version=3.3.1 spammy=actions, Actions X-HELO: eggs.gnu.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (209.51.188.92) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 20 Aug 2019 09:51:33 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1i00nb-0005Np-9d for gcc-patches@gcc.gnu.org; Tue, 20 Aug 2019 05:51:32 -0400 Received: from rock.gnat.com ([2620:20:4000:0:a9e:1ff:fe9b:1d1]:55603) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1i00nb-0005NT-4e for gcc-patches@gcc.gnu.org; Tue, 20 Aug 2019 05:51:31 -0400 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id BDF70560CB; Tue, 20 Aug 2019 05:51:30 -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 6wV+KtsF4KmV; Tue, 20 Aug 2019 05:51:30 -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 AC062560C2; Tue, 20 Aug 2019 05:51:30 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id AB15E63E; Tue, 20 Aug 2019 05:51:30 -0400 (EDT) Date: Tue, 20 Aug 2019 05:51:30 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Crash on a Storage_Size aspect depending on attr. of another type Message-ID: <20190820095130.GA75626@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-Received-From: 2620:20:4000:0:a9e:1ff:fe9b:1d1 X-IsSubscribed: yes This patch fixes a crash on an aspect specification for Storage_Size for a type T when the expression for the aspect depends on attributes of a previously declared type that is not frozen yet. The temporary declaration that captures the value of the aspect must be part of the actions attached to the freeze node for T. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-08-20 Ed Schonberg gcc/ada/ * exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case Storage_Size): If the expression for Storage_Size is not static it may depend on characterstics of another type that may bot be frozen yet, so the elaboration of the expression for the aspect must be attached directly to the freeze actions of the type to which it applies. gcc/testsuite/ * gnat.dg/storage_size1.adb: New testcase. --- gcc/ada/exp_ch13.adb +++ gcc/ada/exp_ch13.adb @@ -220,9 +220,9 @@ package body Exp_Ch13 is -- task_typeZ := expression if Ekind (Ent) = E_Task_Type then + declare Assign : Node_Id; - begin Assign := Make_Assignment_Statement (Loc, @@ -261,15 +261,35 @@ package body Exp_Ch13 is Make_Defining_Identifier (Loc, Chars => New_External_Name (Chars (Ent), 'V')); - -- Insert the declaration of the object - - Insert_Action (N, - Make_Object_Declaration (Loc, - Defining_Identifier => V, - Object_Definition => - New_Occurrence_Of (RTE (RE_Storage_Offset), Loc), - Expression => - Convert_To (RTE (RE_Storage_Offset), Expression (N)))); + -- Insert the declaration of the object. If the expression + -- is not static it may depend on some other type that is + -- not frozen yet, so attach the declaration that captures + -- the value of the expression to the actions of the freeze + -- node of the current type. + + declare + Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => V, + Object_Definition => + New_Occurrence_Of (RTE (RE_Storage_Offset), Loc), + Expression => + Convert_To + (RTE (RE_Storage_Offset), Expression (N))); + begin + if not Is_OK_Static_Expression (Expression (N)) + and then Present (Freeze_Node (Ent)) + then + if No (Actions (Freeze_Node (Ent))) then + Set_Actions (Freeze_Node (Ent), New_List (Decl)); + else + Append (Decl, Actions (Freeze_Node (Ent))); + end if; + + else + Insert_Action (N, Decl); + end if; + end; Set_Storage_Size_Variable (Ent, Entity_Id (V)); end if; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/storage_size1.adb @@ -0,0 +1,19 @@ +-- { dg-do compile } + +with Ada.Text_IO; with Ada.Integer_Text_IO; + +procedure Storage_Size1 is + + package O renames Ada.Text_IO; + package T renames Ada.Integer_Text_IO; + + type Struct is record first, second: Integer; end record; + + type SP is access Struct + with Storage_Size => 64 * Struct'Max_Size_In_Storage_Elements; + +begin + + T.Put(SP'Storage_Size); O.New_Line(1); + +end Storage_Size1;