From patchwork Mon Aug 6 07:59:06 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 175288 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]) by ozlabs.org (Postfix) with SMTP id 97D672C00A2 for ; Mon, 6 Aug 2012 17:59:25 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1344844766; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=jirGRqTumYoUCAn3smTV 5YATTZo=; b=H8vhCBzHUmT1ozGKcSGmSdQ8+i3opS9KFyeJsDD0E117Bd6OGbYo WOWH3eljDKIkuavPzN7qn3tTtUSYtpPClk8moi/SrgsTHsfE0QtmLoyPUqEwGfLT jPh9Kstn45W6mGWXS2LVRC6C1hHhGzrRyO3U90JLu4nfsqPFY2BwosA= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=rPYadni7IRS9Y1NKc8pNIgeYXyOKop0KuVqB81+/TgK+IOjfH3EY/AXdL1mq1N TOuuXU5z6UabbU/SY8fIZiHUMdVptpffKRlhdZFHmu8BMTaQFmI/anCqhpZpXRpC w25/CsTR4x6itf8u2/eCi3ZPhmIcWZurR2nkifqoCa3UQ=; Received: (qmail 13638 invoked by alias); 6 Aug 2012 07:59:21 -0000 Received: (qmail 13628 invoked by uid 22791); 6 Aug 2012 07:59:20 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO, TW_TM X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 06 Aug 2012 07:59:07 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E71481C7372; Mon, 6 Aug 2012 03:59: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 H5oEzojhbjir; Mon, 6 Aug 2012 03:59:06 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id A9EEE1C7318; Mon, 6 Aug 2012 03:59:06 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id A2A7292BF6; Mon, 6 Aug 2012 03:59:06 -0400 (EDT) Date: Mon, 6 Aug 2012 03:59:06 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Redundant finalization of controlled function result Message-ID: <20120806075906.GA4344@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 This patch removes obsolete code related to array initialization. When an array is initialized by an aggregate, the compiler may generate a loop to initialize all elements. If the aggregate contains controlled function calls, the loop statements are wrapped in a block for finalization purposes. The block already handles proper finalization of transient objects so it no longer needs the specialized processing performed in Process_Transient_Objects. ------------ -- Source -- ------------ -- types.ads with Ada.Finalization; use Ada.Finalization; package Types is type Ctrl is new Controlled with record Id : Natural; end record; procedure Adjust (Obj : in out Ctrl); procedure Finalize (Obj : in out Ctrl); procedure Initialize (Obj : in out Ctrl); end Types; -- types.adb with Ada.Text_IO; use Ada.Text_IO; package body Types is Id_Gen : Natural := 0; procedure Adjust (Obj : in out Ctrl) is New_Id : constant Natural := Obj.Id * 100; begin Put_Line (" adj" & Obj.Id'Img & " ->" & New_Id'Img); Obj.Id := New_Id; end Adjust; procedure Finalize (Obj : in out Ctrl) is begin Put_Line (" fin" & Obj.Id'Img); end Finalize; procedure Initialize (Obj : in out Ctrl) is begin Id_Gen := Id_Gen + 1; Obj.Id := Id_Gen; Put_Line (" ini" & Obj.Id'Img); end Initialize; end Types; -- main.adb with Types; use Types; procedure Main is function Create return Ctrl is begin return Obj : Ctrl; end Create; Container : array (1 .. 2) of Ctrl := (others => Create); begin null; end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q -gnat05 main.adb $ ./main ini 1 adj 1 -> 100 fin 1 adj 100 -> 10000 fin 100 ini 2 adj 2 -> 200 fin 2 adj 200 -> 20000 fin 200 fin 20000 fin 10000 Tested on x86_64-pc-linux-gnu, committed on trunk 2012-08-06 Hristian Kirtchev * exp_ch7.adb (Process_Transient_Objects): Remove obsolete loop processing related to array initialization. The expansion of loops already contains a mechanism to detect controlled objects generated by expansion and introduce a block around the loop statements for finalization purposes. Index: exp_ch7.adb =================================================================== --- exp_ch7.adb (revision 190155) +++ exp_ch7.adb (working copy) @@ -4585,48 +4585,12 @@ end if; Prev_Fin := Fin_Block; + end if; - -- When the associated node is an array object, the expander may - -- sometimes generate a loop and create transient objects inside - -- the loop. + -- Terminate the scan after the last object has been processed to + -- avoid touching unrelated code. - elsif Nkind (Related_Node) = N_Object_Declaration - and then Is_Array_Type - (Base_Type - (Etype (Defining_Identifier (Related_Node)))) - and then Nkind (Stmt) = N_Loop_Statement - then - declare - Block_HSS : Node_Id := First (Statements (Stmt)); - - begin - -- The loop statements may have been wrapped in a block by - -- Process_Statements_For_Controlled_Objects, inspect the - -- handled sequence of statements. - - if Nkind (Block_HSS) = N_Block_Statement - and then No (Next (Block_HSS)) - then - Block_HSS := Handled_Statement_Sequence (Block_HSS); - - Process_Transient_Objects - (First_Object => First (Statements (Block_HSS)), - Last_Object => Last (Statements (Block_HSS)), - Related_Node => Related_Node); - - -- Inspect the statements of the loop - - else - Process_Transient_Objects - (First_Object => First (Statements (Stmt)), - Last_Object => Last (Statements (Stmt)), - Related_Node => Related_Node); - end if; - end; - - -- Terminate the scan after the last object has been processed - - elsif Stmt = Last_Object then + if Stmt = Last_Object then exit; end if;