This patch corrects an issue whereby variant records with controlled components
would skip generation of finalization routines due to a counter (Num_Comps)
improperly being reset.
------------
-- Source --
------------
-- map_leak.adb
with Ada.Strings.Hash;
with Ada.Containers.Indefinite_Hashed_Maps;
procedure Map_Leak is
package Directory_Statuses is new Ada.Containers.Indefinite_Hashed_Maps
(Key_Type => String,
Element_Type => Integer,
Hash => Ada.Strings.Hash,
Equivalent_Keys => "=");
use Directory_Statuses;
type Project_Tree_Data (Is_Aggregated : Boolean) is record
Directories : Directory_Statuses.Map;
case Is_Aggregated is
when False =>
null;
when True =>
null;
end case;
end record;
PTD : Project_Tree_Data (Is_Aggregated => False);
begin
PTD.Directories.Include ("opopop", 1);
PTD.Directories.Clear;
end Map_Leak;
----------------------------
-- Compilation and output --
----------------------------
& gnatmake -q -gnatDG map_leak.adb
& grep -c "map_leak__directory_statuses__finalize__2" map_leak.adb.dg
12
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-27 Justin Squirek <squi...@adacore.com>
* exp_ch7.adb (Build_Finalize_Statements): Move Num_Comps to
Process_Component_List_For_Finalization as a local variable.
(Process_Component_For_Finalize): Add an extra parameter to avoid
global references.
(Process_Component_List_For_Finalization): Correct calls to
Process_Component_For_Finalize to take Num_Comps as a parameter.
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb (revision 247299)
+++ exp_ch7.adb (working copy)
@@ -6935,7 +6935,6 @@
Counter : Int := 0;
Finalizer_Data : Finalization_Exception_Data;
- Num_Comps : Nat := 0;
function Process_Component_List_For_Finalize
(Comps : Node_Id) return List_Id;
@@ -6951,25 +6950,28 @@
(Comps : Node_Id) return List_Id
is
procedure Process_Component_For_Finalize
- (Decl : Node_Id;
- Alts : List_Id;
- Decls : List_Id;
- Stmts : List_Id);
+ (Decl : Node_Id;
+ Alts : List_Id;
+ Decls : List_Id;
+ Stmts : List_Id;
+ Num_Comps : in out Nat);
-- Process the declaration of a single controlled component. If
-- flag Is_Local is enabled, create the corresponding label and
-- jump circuitry. Alts is the list of case alternatives, Decls
-- is the top level declaration list where labels are declared
- -- and Stmts is the list of finalization actions.
+ -- and Stmts is the list of finalization actions. Num_Comps
+ -- denotes the current number of components needing finalization.
------------------------------------
-- Process_Component_For_Finalize --
------------------------------------
procedure Process_Component_For_Finalize
- (Decl : Node_Id;
- Alts : List_Id;
- Decls : List_Id;
- Stmts : List_Id)
+ (Decl : Node_Id;
+ Alts : List_Id;
+ Decls : List_Id;
+ Stmts : List_Id;
+ Num_Comps : in out Nat)
is
Id : constant Entity_Id := Defining_Identifier (Decl);
Typ : constant Entity_Id := Etype (Id);
@@ -7075,6 +7077,7 @@
Jump_Block : Node_Id;
Label : Node_Id;
Label_Id : Entity_Id;
+ Num_Comps : Nat;
Stmts : List_Id;
Var_Case : Node_Id;
@@ -7185,7 +7188,8 @@
and then Has_Access_Constraint (Decl_Id)
and then No (Expression (Decl))
then
- Process_Component_For_Finalize (Decl, Alts, Decls, Stmts);
+ Process_Component_For_Finalize
+ (Decl, Alts, Decls, Stmts, Num_Comps);
end if;
Prev_Non_Pragma (Decl);
@@ -7212,7 +7216,8 @@
then
null;
else
- Process_Component_For_Finalize (Decl, Alts, Decls, Stmts);
+ Process_Component_For_Finalize
+ (Decl, Alts, Decls, Stmts, Num_Comps);
end if;
end if;
