From patchwork Tue Sep 17 08:06:32 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: 1163202 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-509070-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="IBERNOHl"; 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 46XbKy70NTz9sN1 for ; Tue, 17 Sep 2019 18:06:44 +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=ZtNn7Hl9r7I3SmFZ1f0UZALxc5aBRTx/A5zSlGxRf1bJc9PerY eY/6nc7E55R2qTkrE9M7IkCuMUVD4ekNjHZNpflMW23IDVidRf2pPi/4gZRY+bNW MG9B2JFnY87/qQgQC1s2MZWU4qlNcB1vv5LmR7VetZHHhIAOz7weaGC/Q= 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=W8cGOvGJYopb2rhFiIO4o9+QpCg=; b=IBERNOHlxCZe/dVur4KF 7gYFnNkZtDrQmXziLKQoOBhXoW1sW1I/7AZWeB1CfmuryUfGQe+2VuIFHFD3J7Vo rqT4MO0knDRH5O/eYfjp2lr1hmzhISu0MK0pHNgyubupdQaAsqki4/lE6OK0vvJ5 HlabGrFXr9wZnENSvKyHCZg= Received: (qmail 29471 invoked by alias); 17 Sep 2019 08:06:36 -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 29453 invoked by uid 89); 17 Sep 2019 08:06:36 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=pref, exp_ch5 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; Tue, 17 Sep 2019 08:06:34 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id EA1F6117A65; Tue, 17 Sep 2019 04:06:32 -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 4MvJMktfIteE; Tue, 17 Sep 2019 04:06:32 -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 D639E117809; Tue, 17 Sep 2019 04:06:32 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id D4FD96AD; Tue, 17 Sep 2019 04:06:32 -0400 (EDT) Date: Tue, 17 Sep 2019 04:06:32 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix wrong value of 'Size for slices of bit-packed arrays Message-ID: <20190917080632.GA37354@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This fixes a long-standing issue in the compiler which would return a wrong value for the Size attribute applied to slices of bit-packed arrays whose size is not a multiple of the storage unit. The problem is that the computation was done in the code generator after the bit-packed array had been internally rewritten into an array of bytes, so the Size was always rounded up to the next byte. The computation is now rewritten into the product of the Length and Compnent_Size attribute of the slices before being sent to the code generator. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-09-17 Eric Botcazou gcc/ada/ * exp_attr.adb (Expand_Size_Attribute): Chain the special cases on the back-end path and rewrite the attribute appled to slices of bit-packed arrays into the product of the Length and the Compoent_Size attributes of the slices. * exp_ch5.adb (Expand_Assign_Array_Bitfield): Use Size attribute directly to compute the bitfield's size. gcc/testsuite/ * gnat.dg/pack25.adb: New testcase. --- gcc/ada/exp_attr.adb +++ gcc/ada/exp_attr.adb @@ -7600,18 +7600,36 @@ package body Exp_Attr is New_Occurrence_Of (Get_Actual_Subtype (Pref), Loc), Attribute_Name => Name_Size)); Analyze_And_Resolve (N, Typ); - end if; - -- If Size applies to a dereference of an access to unconstrained + -- If Size is applied to a dereference of an access to unconstrained -- packed array, the back end needs to see its unconstrained nominal -- type, but also a hint to the actual constrained type. - if Nkind (Pref) = N_Explicit_Dereference + elsif Nkind (Pref) = N_Explicit_Dereference and then Is_Array_Type (Ptyp) and then not Is_Constrained (Ptyp) and then Is_Packed (Ptyp) then Set_Actual_Designated_Subtype (Pref, Get_Actual_Subtype (Pref)); + + -- If Size was applied to a slice of a bit-packed array, we rewrite + -- it into the product of Length and Component_Size. We need to do so + -- because bit-packed arrays are represented internally as arrays of + -- System.Unsigned_Types.Packed_Byte for code generation purposes so + -- the size is always rounded up in the back end. + + elsif Nkind (Original_Node (Pref)) = N_Slice + and then Is_Bit_Packed_Array (Ptyp) + then + Rewrite (N, + Make_Op_Multiply (Loc, + Make_Attribute_Reference (Loc, + Prefix => Duplicate_Subexpr (Pref, True), + Attribute_Name => Name_Length), + Make_Attribute_Reference (Loc, + Prefix => Duplicate_Subexpr (Pref, True), + Attribute_Name => Name_Component_Size))); + Analyze_And_Resolve (N, Typ); end if; return; --- gcc/ada/exp_ch5.adb +++ gcc/ada/exp_ch5.adb @@ -1408,23 +1408,15 @@ package body Exp_Ch5 is Expressions => New_List (New_Copy_Tree (Right_Lo))), Attribute_Name => Name_Bit); - -- Compute the Size of the bitfield. ???We can't use Size here, because - -- it doesn't work properly for slices of packed arrays, so we compute - -- the L'Size as L'Length*L'Component_Size. - -- + -- Compute the Size of the bitfield + -- Note that the length check has already been done, so we can use the -- size of either L or R. Size : constant Node_Id := - Make_Op_Multiply (Loc, - Make_Attribute_Reference (Loc, - Prefix => - Duplicate_Subexpr (Name (N), True), - Attribute_Name => Name_Length), - Make_Attribute_Reference (Loc, - Prefix => - Duplicate_Subexpr (Name (N), True), - Attribute_Name => Name_Component_Size)); + Make_Attribute_Reference (Loc, + Prefix => Duplicate_Subexpr (Name (N), True), + Attribute_Name => Name_Size); begin return Make_Procedure_Call_Statement (Loc, --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/pack25.adb @@ -0,0 +1,21 @@ +-- { dg-do run } +procedure Pack25 is + + type Bit is ('0', '1'); + type Bit_Array is array (Natural range <>) of Bit; + pragma Pack (Bit_Array); + + procedure Test (Bits : Bit_Array; Size : Natural) is + begin + if Bits (0 .. Size - 1)'Size /= Size then + raise Program_Error; + end if; + end; + + A : Bit_Array (0 .. 127) := (others => '1'); + +begin + for X in A'First .. A'Last + 1 loop + Test (A, X); + end loop; +end; \ No newline at end of file