===================================================================
@@ -3599,7 +3599,7 @@
and then VM_Target = No_VM;
Actions_Required : constant Boolean :=
- Requires_Cleanup_Actions (N)
+ Requires_Cleanup_Actions (N, True)
or else Is_Asynchronous_Call
or else Is_Master
or else Is_Protected_Body
===================================================================
@@ -150,16 +150,16 @@
function Requires_Cleanup_Actions
(L : List_Id;
- For_Package : Boolean;
+ Lib_Level : Boolean;
Nested_Constructs : Boolean) return Boolean;
-- Given a list L, determine whether it contains one of the following:
--
-- 1) controlled objects
-- 2) library-level tagged types
--
- -- Flag For_Package should be set when the list comes from a package spec
- -- or body. Flag Nested_Constructs should be set when any nested packages
- -- declared in L must be processed.
+ -- Flag Lib_Level should be set when the list comes from a construct at
+ -- the library level. Flag Nested_Constructs should be set when any nested
+ -- packages declared in L must be processed.
-------------------------------------
-- Activate_Atomic_Synchronization --
@@ -7038,9 +7038,14 @@
-- Requires_Cleanup_Actions --
------------------------------
- function Requires_Cleanup_Actions (N : Node_Id) return Boolean is
- For_Pkg : constant Boolean :=
- Nkind_In (N, N_Package_Body, N_Package_Specification);
+ function Requires_Cleanup_Actions
+ (N : Node_Id;
+ Lib_Level : Boolean) return Boolean
+ is
+ At_Lib_Level : constant Boolean := Lib_Level and then
+ Nkind_In (N, N_Package_Body, N_Package_Specification);
+ -- N is at the library level if the top-most context is a package and
+ -- the path taken to reach N does not inlcude non-package constructs.
begin
case Nkind (N) is
@@ -7052,20 +7057,20 @@
N_Subprogram_Body |
N_Task_Body =>
return
- Requires_Cleanup_Actions (Declarations (N), For_Pkg, True)
+ Requires_Cleanup_Actions (Declarations (N), At_Lib_Level, True)
or else
(Present (Handled_Statement_Sequence (N))
and then
Requires_Cleanup_Actions (Statements
- (Handled_Statement_Sequence (N)), For_Pkg, True));
+ (Handled_Statement_Sequence (N)), At_Lib_Level, True));
when N_Package_Specification =>
return
Requires_Cleanup_Actions
- (Visible_Declarations (N), For_Pkg, True)
+ (Visible_Declarations (N), At_Lib_Level, True)
or else
Requires_Cleanup_Actions
- (Private_Declarations (N), For_Pkg, True);
+ (Private_Declarations (N), At_Lib_Level, True);
when others =>
return False;
@@ -7078,7 +7083,7 @@
function Requires_Cleanup_Actions
(L : List_Id;
- For_Package : Boolean;
+ Lib_Level : Boolean;
Nested_Constructs : Boolean) return Boolean
is
Decl : Node_Id;
@@ -7125,9 +7130,7 @@
-- finalization disabled. This applies only to objects at the
-- library level.
- if For_Package
- and then Finalize_Storage_Only (Obj_Typ)
- then
+ if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then
null;
-- Transient variables are treated separately in order to minimize
@@ -7203,9 +7206,7 @@
-- finalization disabled. This applies only to objects at the
-- library level.
- if For_Package
- and then Finalize_Storage_Only (Obj_Typ)
- then
+ if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then
null;
-- Return object of a build-in-place function. This case is
@@ -7257,7 +7258,7 @@
(Is_Type (Typ)
and then Needs_Finalization (Typ)))
and then Requires_Cleanup_Actions
- (Actions (Decl), For_Package, Nested_Constructs)
+ (Actions (Decl), Lib_Level, Nested_Constructs)
then
return True;
end if;
@@ -7274,7 +7275,8 @@
end if;
if Ekind (Pack_Id) /= E_Generic_Package
- and then Requires_Cleanup_Actions (Specification (Decl))
+ and then Requires_Cleanup_Actions
+ (Specification (Decl), Lib_Level)
then
return True;
end if;
@@ -7287,7 +7289,7 @@
Pack_Id := Corresponding_Spec (Decl);
if Ekind (Pack_Id) /= E_Generic_Package
- and then Requires_Cleanup_Actions (Decl)
+ and then Requires_Cleanup_Actions (Decl, Lib_Level)
then
return True;
end if;
===================================================================
@@ -744,14 +744,17 @@
-- terms is scalar. This is true for scalars in the Ada sense, and for
-- packed arrays which are represented by a scalar (modular) type.
- function Requires_Cleanup_Actions (N : Node_Id) return Boolean;
+ function Requires_Cleanup_Actions
+ (N : Node_Id;
+ Lib_Level : Boolean) return Boolean;
-- Given a node N, determine whether its declarative and/or statement list
-- contains one of the following:
--
-- 1) controlled objects
-- 2) library-level tagged types
--
- -- The above cases require special actions on scope exit.
+ -- The above cases require special actions on scope exit. Flag Lib_Level
+ -- is used to track whether a construct is at the library level.
function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
-- Given the node for an N_Unchecked_Type_Conversion, return True if this
This patch corrects the mechanism which determines whether a construct appears at the library level. This in turn allows for proper detection of cases where a Finalize_Storage_Only object appears in a nested scope and requires finalization. ------------ -- Source -- ------------ -- main.adb with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; procedure Main is generic package Memory_File is File : Unbounded_String; procedure Add_String (S : String); procedure Add_New_Line; end Memory_File; package body Memory_File is procedure Add_String (S : String) is begin Append (File, S); end Add_String; procedure Add_New_Line is begin Add_String (ASCII.CR & ASCII.LF); end Add_New_Line; end Memory_File; function Leak return String is package Mem is new Memory_File; use Mem; begin Add_String ("This is a test"); Add_New_Line; return To_String (File); end Leak; begin for Index in 1 .. 100 loop declare Result : String := Leak; pragma Warnings (Off, Result); begin null; end; end loop; end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q main.adb -largs -lgmem $ ./main $ gnatmem ./main $ Global information $ ------------------ $ Total number of allocations : 100 $ Total number of deallocations : 100 $ Final Water Mark (non freed mem) : 0 Bytes $ High Water Mark : 48 Bytes Tested on x86_64-pc-linux-gnu, committed on trunk 2012-04-26 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch7.adb (Expand_Cleanup_Actions): Update the call to Requires_Cleanup_Actions. * exp_util.adb (Requires_Cleanup_Actions (List_Id; Boolean; Boolean)): Rename formal parameter For_Package to Lib_Level to better reflect its purpose. Update the related comment and all occurrences of For_Package in the body. (Requires_Cleanup_Actions (Node_Id; Boolean)): Add new formal parameter Lib_Level. Add local constant At_Lib_Level to keep monitor whether the path taken from the top-most context to the current construct involves package constructs. Update all calls to Requires_Cleanup_Actions. * exp_util.ads (Requires_Cleanup_Actions): Add new formal parameter Lib_Level and associated comment.