From patchwork Wed Sep 18 08:39:45 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: 1163844 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-509183-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="OmclhDfw"; 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 46YD651FKHz9sCJ for ; Wed, 18 Sep 2019 18:43:40 +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=wNnP87NrGYm4pz+hETOOQt1XrVX7E23emz8F5BXH3M+jm6K8jG 7+DIyb4Aj3lCBLJ6fcatP46Fy8RJzo8Dkvae3Dv1vlvZyFSdTCv9vQODyWhl7CrK PzVoPg3mkLdgrK/wLi1zxWapCGGzzmMHfoM3P64V29syxJiH9BjQwg3BU= 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=8FZpkhSrShP3f/zEooX7wz9ohjg=; b=OmclhDfwyQf/SBwk+pgy QKoldCE6FVadVFv34MDUxGbWqMNkiv5yPFWSR4044DFMJIFMDpUzr6x49hu+KWyb OqC7g28gb1Ak5S1sFh7vPdsN2aaeFZM5hmt5i6pC/9YTQMIjwoX9imwLvV4WXASX T5DCR6rmz4OVtZD/y0J6uxU= Received: (qmail 104151 invoked by alias); 18 Sep 2019 08:40:15 -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 102065 invoked by uid 89); 18 Sep 2019 08:39:59 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, SPF_NEUTRAL autolearn=ham version=3.3.1 spammy= 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; Wed, 18 Sep 2019 08:39:58 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iAVVC-0008I9-6V for gcc-patches@gcc.gnu.org; Wed, 18 Sep 2019 04:39:55 -0400 Received: from rock.gnat.com ([205.232.38.15]:43776) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1iAVVA-0008FX-AU for gcc-patches@gcc.gnu.org; Wed, 18 Sep 2019 04:39:53 -0400 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 7CDB7117D28; Wed, 18 Sep 2019 04:39:45 -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 SqRKlvrPI0Sd; Wed, 18 Sep 2019 04:39:45 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 4C1A4117CFD; Wed, 18 Sep 2019 04:39:45 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 4AF18702; Wed, 18 Sep 2019 04:39:45 -0400 (EDT) Date: Wed, 18 Sep 2019 04:39:45 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix sharing of expression in array aggregate with others choice Message-ID: <20190918083945.GA145214@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 X-Received-From: 205.232.38.15 X-IsSubscribed: yes This change fixes a long-standing issue in the compiler that is generally silent but may lead to wrong code generation in specific circumstances. When an others choice in an array aggregate spans multiple ranges, the compiler may generate multiple (groups of) assignments for the ranges. The problem is that it internally reuses the original expression for all the ranges, which is problematic if this expression gets rewritten during the processing of one of the ranges and typically causes a new temporary to be shared between different ranges. The solution is to duplicate the original expression for each range. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-09-18 Eric Botcazou gcc/ada/ * exp_aggr.adb (Build_Array_Aggr_Code): In STEP 1 (c), duplicate the expression and reset the Loop_Actions for each loop generated for an others choice. gcc/testsuite/ * gnat.dg/aggr28.adb: New testcase. --- gcc/ada/exp_aggr.adb +++ gcc/ada/exp_aggr.adb @@ -2075,7 +2075,6 @@ package body Exp_Aggr is Choice := First (Choice_List (Assoc)); while Present (Choice) loop if Nkind (Choice) = N_Others_Choice then - Set_Loop_Actions (Assoc, New_List); Others_Assoc := Assoc; exit; end if; @@ -2122,7 +2121,8 @@ package body Exp_Aggr is if Present (Others_Assoc) then declare - First : Boolean := True; + First : Boolean := True; + Dup_Expr : Node_Id; begin for J in 0 .. Nb_Choices loop @@ -2160,9 +2160,19 @@ package body Exp_Aggr is or else not Empty_Range (Low, High) then First := False; + + -- Duplicate the expression in case we will be generating + -- several loops. As a result the expression is no longer + -- shared between the loops and is reevaluated for each + -- such loop. + + Expr := Get_Assoc_Expr (Others_Assoc); + Dup_Expr := New_Copy_Tree (Expr); + Set_Parent (Dup_Expr, Parent (Expr)); + + Set_Loop_Actions (Others_Assoc, New_List); Append_List - (Gen_Loop (Low, High, - Get_Assoc_Expr (Others_Assoc)), To => New_Code); + (Gen_Loop (Low, High, Dup_Expr), To => New_Code); end if; end loop; end; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/aggr28.adb @@ -0,0 +1,29 @@ +-- { dg-do run } + +procedure Aggr28 is + + Count : Natural := 0; + + function Get (S: String) return String is + begin + Count := Count + 1; + return S; + end; + + Max_Error_Length : constant := 8; + subtype Error_Type is String (1 .. Max_Error_Length); + + type Rec is record + Text : Error_Type; + end record; + + type Arr is array (1 .. 16) of Rec; + + Table : constant Arr := + (3 => (Text => Get ("INVALID ")), others => (Text => Get ("OTHERS "))); + +begin + if Count /= Table'Length then + raise Program_Error; + end if; +end; \ No newline at end of file