From patchwork Wed Apr 20 10:46:04 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 612621 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 3qqdpq0D6mz9t5T for ; Wed, 20 Apr 2016 20:46:25 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=F/TtFfuG; 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=Nq3CxutpzBzbSIkws83iqEMSOm8ypLbRkc7q1njqCjWmyHse+A MwfEj+zUJggT42zcW9yhUCrHilaL00iO9BWHEgceJIUK1pABhCZOU+UF8awuXwKi b3Fct/i4GfrxwliNPKPpgbvtvm8ikQrC3UGpOyv7PYN8JTthjeH715upU= 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=kheOW5GJOABkhXPfjha2PpEEgMI=; b=F/TtFfuGcognG8pkVvO8 Iammxwav7CCQ11ABWtTAQ7RbUqI3OtWRyod9kTuA6er3vnWfIKKo1o66XeBHWkfC RncJ0/XFKhQbwkKAplC+Q8N/NseVE3YYNRWdXyQNrK2tHodtogD8aA5yOQqkEmRM 6Sxq/awz9oANU02u+H8mjsk= Received: (qmail 105490 invoked by alias); 20 Apr 2016 10:46:17 -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 105473 invoked by uid 89); 20 Apr 2016 10:46:16 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=2.4 required=5.0 tests=AWL, BAYES_50, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_NONE autolearn=no version=3.3.2 spammy=elsif, sk:kirtche, kirtchev, U*kirtchev 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 (AES256-SHA encrypted) ESMTPS; Wed, 20 Apr 2016 10:46:06 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5EBC6116C22; Wed, 20 Apr 2016 06:46:04 -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 X23R3TZWCZeP; Wed, 20 Apr 2016 06:46:04 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 4C637116C19; Wed, 20 Apr 2016 06:46:04 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 488651A5; Wed, 20 Apr 2016 06:46:04 -0400 (EDT) Date: Wed, 20 Apr 2016 06:46:04 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Leak with function returning String in exception handler Message-ID: <20160420104604.GA108514@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch modifies the transient scope mechanism to ignore blocks generated for exception handlers with a choice parameter when propagating secondary stack information up the scope stack. Such blocks are not physically present in the tree and can never release the secondary stack on exit. ------------ -- Source -- ------------ -- memory_leak.adb procedure Memory_Leak is function My_String return String is begin return "Foo"; end My_String; begin for I in 1 .. 100_000 loop begin raise Program_Error; exception when E : others => if My_String = "Bar" then raise; end if; end; end loop; end Memory_Leak; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q memory_leak.adb -largs -lgmem $ ./memory_leak $ gnatmem ./memory_leak > output.txt $ grep "Total number of" output.txt Total number of allocations :100000 Total number of deallocations :100000 Tested on x86_64-pc-linux-gnu, committed on trunk 2016-04-20 Hristian Kirtchev * einfo.adb Flag286 is now used as Is_Exception_Handler. (Is_Exception_Handler): New routine. (Set_Is_Exception_Handler): New routine. (Write_Entity_Flags): Output the status of Is_Exception_Handler. * einfo.ads New attribute Is_Exception_Handler along with occurrences in entities. (Is_Exception_Handler): New routine along with pragma Inline. (Set_Is_Exception_Handler): New routine along with pragma Inline. * exp_ch7.adb (Make_Transient_Block): Ignore blocks generated for exception handlers with a choice parameter. * sem_ch11.adb (Analyze_Exception_Handlers): Mark the scope generated for a choice parameter as an exception handler. Index: exp_ch7.adb =================================================================== --- exp_ch7.adb (revision 235258) +++ exp_ch7.adb (working copy) @@ -7993,14 +7993,22 @@ elsif Ekind_In (S, E_Entry, E_Loop) then exit; - -- In a procedure or a block, we release on exit of the - -- procedure or block. ??? memory leak can be created by - -- recursive calls. + -- In a procedure or a block, release the sec stack on exit + -- from the construct. Note that an exception handler with a + -- choice parameter requires a declarative region in the form + -- of a block. The block does not physically manifest in the + -- tree as it only serves as a scope. Do not consider such a + -- block because it will never release the sec stack. - elsif Ekind_In (S, E_Block, E_Procedure) then + -- ??? Memory leak can be created by recursive calls + + elsif Ekind (S) = E_Procedure + or else (Ekind (S) = E_Block + and then not Is_Exception_Handler (S)) + then + Set_Uses_Sec_Stack (Current_Scope, False); Set_Uses_Sec_Stack (S, True); Check_Restriction (No_Secondary_Stack, Action); - Set_Uses_Sec_Stack (Current_Scope, False); exit; else Index: einfo.adb =================================================================== --- einfo.adb (revision 235248) +++ einfo.adb (working copy) @@ -597,7 +597,7 @@ -- Is_Uplevel_Referenced_Entity Flag283 -- Is_Unimplemented Flag284 -- Is_Volatile_Full_Access Flag285 - -- (unused) Flag286 + -- Is_Exception_Handler Flag286 -- Rewritten_For_C Flag287 -- (unused) Flag288 @@ -1976,12 +1976,6 @@ return Flag146 (Id); end Is_Abstract_Type; - function Is_Local_Anonymous_Access (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag194 (Id); - end Is_Local_Anonymous_Access; - function Is_Access_Constant (Id : E) return B is begin pragma Assert (Is_Access_Type (Id)); @@ -2137,6 +2131,12 @@ return Flag52 (Id); end Is_Entry_Formal; + function Is_Exception_Handler (Id : E) return B is + begin + pragma Assert (Ekind (Id) = E_Block); + return Flag286 (Id); + end Is_Exception_Handler; + function Is_Exported (Id : E) return B is begin return Flag99 (Id); @@ -2307,6 +2307,12 @@ return Flag25 (Id); end Is_Limited_Record; + function Is_Local_Anonymous_Access (Id : E) return B is + begin + pragma Assert (Is_Access_Type (Id)); + return Flag194 (Id); + end Is_Local_Anonymous_Access; + function Is_Machine_Code_Subprogram (Id : E) return B is begin pragma Assert (Is_Subprogram (Id)); @@ -5146,6 +5152,12 @@ Set_Flag52 (Id, V); end Set_Is_Entry_Formal; + procedure Set_Is_Exception_Handler (Id : E; V : B := True) is + begin + pragma Assert (Ekind (Id) = E_Block); + Set_Flag286 (Id, V); + end Set_Is_Exception_Handler; + procedure Set_Is_Exported (Id : E; V : B := True) is begin Set_Flag99 (Id, V); @@ -8956,6 +8968,7 @@ W ("Is_Dispatching_Operation", Flag6 (Id)); W ("Is_Eliminated", Flag124 (Id)); W ("Is_Entry_Formal", Flag52 (Id)); + W ("Is_Exception_Handler", Flag286 (Id)); W ("Is_Exported", Flag99 (Id)); W ("Is_First_Subtype", Flag70 (Id)); W ("Is_For_Access_Subtype", Flag118 (Id)); Index: einfo.ads =================================================================== --- einfo.ads (revision 235244) +++ einfo.ads (working copy) @@ -2428,6 +2428,11 @@ -- Is_Enumeration_Type (synthesized) -- Defined in all entities, true for enumeration types and subtypes +-- Is_Exception_Handler (Flag286) +-- Defined in blocks. Set if the block serves only as a scope of an +-- exception handler with a choice parameter. Such a block does not +-- physically appear in the tree. + -- Is_Exported (Flag99) -- Defined in all entities. Set if the entity is exported. For now we -- only allow the export of constants, exceptions, functions, procedures @@ -5621,6 +5626,7 @@ -- Discard_Names (Flag88) -- Has_Master_Entity (Flag21) -- Has_Nested_Block_With_Handler (Flag101) + -- Is_Exception_Handler (Flag286) -- Sec_Stack_Needed_For_Return (Flag167) -- Uses_Sec_Stack (Flag95) -- Scope_Depth (synth) @@ -6971,6 +6977,7 @@ function Is_Dispatching_Operation (Id : E) return B; function Is_Eliminated (Id : E) return B; function Is_Entry_Formal (Id : E) return B; + function Is_Exception_Handler (Id : E) return B; function Is_Exported (Id : E) return B; function Is_First_Subtype (Id : E) return B; function Is_For_Access_Subtype (Id : E) return B; @@ -7634,6 +7641,7 @@ procedure Set_Is_Dispatching_Operation (Id : E; V : B := True); procedure Set_Is_Eliminated (Id : E; V : B := True); procedure Set_Is_Entry_Formal (Id : E; V : B := True); + procedure Set_Is_Exception_Handler (Id : E; V : B := True); procedure Set_Is_Exported (Id : E; V : B := True); procedure Set_Is_First_Subtype (Id : E; V : B := True); procedure Set_Is_For_Access_Subtype (Id : E; V : B := True); @@ -8434,6 +8442,7 @@ pragma Inline (Is_Entry); pragma Inline (Is_Entry_Formal); pragma Inline (Is_Enumeration_Type); + pragma Inline (Is_Exception_Handler); pragma Inline (Is_Exported); pragma Inline (Is_First_Subtype); pragma Inline (Is_Fixed_Point_Type); @@ -8923,6 +8932,7 @@ pragma Inline (Set_Is_Dispatching_Operation); pragma Inline (Set_Is_Eliminated); pragma Inline (Set_Is_Entry_Formal); + pragma Inline (Set_Is_Exception_Handler); pragma Inline (Set_Is_Exported); pragma Inline (Set_Is_First_Subtype); pragma Inline (Set_Is_For_Access_Subtype); Index: sem_ch11.adb =================================================================== --- sem_ch11.adb (revision 235192) +++ sem_ch11.adb (working copy) @@ -214,6 +214,7 @@ H_Scope := New_Internal_Entity (E_Block, Current_Scope, Sloc (Choice), 'E'); + Set_Is_Exception_Handler (H_Scope); end if; Push_Scope (H_Scope); @@ -318,11 +319,11 @@ N_Formal_Package_Declaration then Error_Msg_NE - ("exception& is declared in " & - "generic formal package", Id, Ent); + ("exception& is declared in generic formal " + & "package", Id, Ent); Error_Msg_N - ("\and therefore cannot appear in " & - "handler (RM 11.2(8))", Id); + ("\and therefore cannot appear in handler " + & "(RM 11.2(8))", Id); exit; -- If the exception is declared in an inner @@ -362,8 +363,8 @@ Analyze_Statements (Statements (Handler)); - -- If a choice was present, we created a special scope for it, - -- so this is where we pop that special scope to get rid of it. + -- If a choice was present, we created a special scope for it, so + -- this is where we pop that special scope to get rid of it. if Present (Choice) then End_Scope;