From patchwork Wed Oct 12 13:55:26 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 681309 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org 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 3svFkl6hK8z9s3T for ; Thu, 13 Oct 2016 00:55:59 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=HQ00PsbJ; dkim-atps=neutral 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=LQVnNczR2M8YviN4b1ykYrkMzJYHr97FrCY/VvNQBAOW6cuXT2 8+QERNUByGnl2wMouMorhLaQBjJySNdAQrS0w4kLgEc4JdV8jfe7QeahBhTbgEzf T+wJXoZPMUJaXic5IKCzo+paeY6838iNVmFF9LyDqVPSTGXxXQMoG4k/8= 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=krz/JtOUfs8jL/eD8HxrNqf3+DM=; b=HQ00PsbJrp6pX6jek2sc C28p8p/aCW9DbqUSi6Gh3aHIbkxmj9ViXbIHZceUGM27/XdqUGGG8Eixu5F9FpSO 8pYa69KsDAhCp8+EnjGktuNLAxRZ1g5qlK9nMspm8wBYOYBRBR5egoTueARXVSMs nhZx4J6hK1rNcLbTc7osN9k= Received: (qmail 105657 invoked by alias); 12 Oct 2016 13:55:38 -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 105626 invoked by uid 89); 12 Oct 2016 13:55:37 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.9 required=5.0 tests=BAYES_00, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPELLED_OUT_NUMBER, SPF_PASS autolearn=no version=3.3.2 spammy=to_string, sk:in_plac, plugs, n_identifier 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, 12 Oct 2016 13:55:27 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 37A3D116A4B; Wed, 12 Oct 2016 09:55:26 -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 vXSdaYGI3LkI; Wed, 12 Oct 2016 09:55:26 -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 23B58116A49; Wed, 12 Oct 2016 09:55:26 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 1FD7643D; Wed, 12 Oct 2016 09:55:26 -0400 (EDT) Date: Wed, 12 Oct 2016 09:55:26 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Premature finalization of controlled array component Message-ID: <20161012135526.GA64980@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch modifies the processing of transient array components to properly handle the finalization of the temporary controlled function result when the call initializes a component choice list or an "others" choice. ------------ -- Source -- ------------ -- aggregates.adb with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Text_IO; use Ada.Text_IO; procedure Aggregates is begin declare Arr : array (1 .. 3) of Unbounded_String := (2 => To_Unbounded_String ("two"), others => To_Unbounded_String ("others")); begin Put ("others "); Put_Line (To_String (Arr (1))); Put ("two "); Put_Line (To_String (Arr (2))); Put ("others "); Put_Line (To_String (Arr (3))); end; declare Arr : array (1 .. 4) of Unbounded_String := (1 | 3 | 4 => To_Unbounded_String ("one_three_four"), 2 => To_Unbounded_String ("two")); begin Put ("one_three_four "); Put_Line (To_String (Arr (1))); Put ("two "); Put_Line (To_String (Arr (2))); Put ("one_three_four "); Put_Line (To_String (Arr (3))); Put ("one_three_four "); Put_Line (To_String (Arr (4))); end; declare Arr : array (1 .. 3) of Unbounded_String := (1 .. 2 => To_Unbounded_String ("one_two"), others => To_Unbounded_String ("others")); begin Put ("one_two "); Put_Line (To_String (Arr (1))); Put ("one_two "); Put_Line (To_String (Arr (2))); Put ("others "); Put_Line (To_String (Arr (3))); end; declare Arr : array (1 .. 4) of Unbounded_String := (1 => To_Unbounded_String ("one"), 2 .. 4 => To_Unbounded_String ("two_four")); begin Put ("one "); Put_Line (To_String (Arr (1))); Put ("two_four "); Put_Line (To_String (Arr (2))); Put ("two_four "); Put_Line (To_String (Arr (3))); Put ("two_four "); Put_Line (To_String (Arr (4))); end; declare Arr : array (1 .. 5) of Unbounded_String := (1 .. 2 => To_Unbounded_String ("one_two"), 4 | 5 => To_Unbounded_String ("four_five"), others => To_Unbounded_String ("others")); begin Put ("one_two "); Put_Line (To_String (Arr (1))); Put ("one_two "); Put_Line (To_String (Arr (2))); Put ("others "); Put_Line (To_String (Arr (3))); Put ("four_five "); Put_Line (To_String (Arr (4))); Put ("four_five "); Put_Line (To_String (Arr (5))); end; end Aggregates; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q aggregates.adb $ ./aggregates others others two two others others one_three_four one_three_four two two one_three_four one_three_four one_three_four one_three_four one_two one_two one_two one_two others others one one two_four two_four two_four two_four two_four two_four one_two one_two one_two one_two others others four_five four_five four_five four_five Tested on x86_64-pc-linux-gnu, committed on trunk 2016-10-12 Hristian Kirtchev * exp_aggr.adb (Initialize_Ctrl_Array_Component): Create a copy of the initialization expression to avoid sharing it between multiple components. Index: exp_aggr.adb =================================================================== --- exp_aggr.adb (revision 241024) +++ exp_aggr.adb (working copy) @@ -1277,6 +1277,7 @@ is Act_Aggr : Node_Id; Act_Stmts : List_Id; + Expr : Node_Id; Fin_Call : Node_Id; Hook_Clear : Node_Id; @@ -1285,20 +1286,29 @@ -- in-place expansion. begin + -- Duplicate the initialization expression in case the context is + -- a multi choice list or an "others" choice which plugs various + -- holes in the aggregate. As a result the expression is no longer + -- shared between the various components and is reevaluated for + -- each such component. + + Expr := New_Copy_Tree (Init_Expr); + Set_Parent (Expr, Parent (Init_Expr)); + -- Perform a preliminary analysis and resolution to determine what -- the initialization expression denotes. An unanalyzed function -- call may appear as an identifier or an indexed component. - if Nkind_In (Init_Expr, N_Function_Call, - N_Identifier, - N_Indexed_Component) - and then not Analyzed (Init_Expr) + if Nkind_In (Expr, N_Function_Call, + N_Identifier, + N_Indexed_Component) + and then not Analyzed (Expr) then - Preanalyze_And_Resolve (Init_Expr, Comp_Typ); + Preanalyze_And_Resolve (Expr, Comp_Typ); end if; In_Place_Expansion := - Nkind (Init_Expr) = N_Function_Call + Nkind (Expr) = N_Function_Call and then not Is_Limited_Type (Comp_Typ); -- The initialization expression is a controlled function call. @@ -1315,7 +1325,7 @@ -- generation of a transient scope, which leads to out-of-order -- adjustment and finalization. - Set_No_Side_Effect_Removal (Init_Expr); + Set_No_Side_Effect_Removal (Expr); -- When the transient component initialization is related to a -- range or an "others", keep all generated statements within @@ -1341,7 +1351,7 @@ Process_Transient_Component (Loc => Loc, Comp_Typ => Comp_Typ, - Init_Expr => Init_Expr, + Init_Expr => Expr, Fin_Call => Fin_Call, Hook_Clear => Hook_Clear, Aggr => Act_Aggr, @@ -1356,7 +1366,7 @@ Initialize_Array_Component (Arr_Comp => Arr_Comp, Comp_Typ => Comp_Typ, - Init_Expr => Init_Expr, + Init_Expr => Expr, Stmts => Stmts); -- At this point the array element is fully initialized. Complete