This patch adds task synchronization code to the mechanism which sets TSS
primitive Finalize_Address at run time. The following test should compile
and execute quietly.
-------------
-- Sources --
-------------
-- main.adb:
with Ada.Finalization; use Ada.Finalization;
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
Max_Tasks : constant Natural := 200;
Expected : constant Natural := Max_Tasks / 2;
Even_Count : Natural := 0;
Odd_Count : Natural := 0;
begin
declare
type Even_Tracker is new Controlled with null record;
procedure Finalize (Obj : in out Even_Tracker);
procedure Finalize (Obj : in out Even_Tracker) is
begin
Even_Count := Even_Count + 1;
end Finalize;
type Odd_Tracker is new Controlled with null record;
procedure Finalize (Obj : in out Odd_Tracker);
procedure Finalize (Obj : in out Odd_Tracker) is
begin
Odd_Count := Odd_Count + 1;
end Finalize;
type Root is tagged null record;
subtype Any_Root is Root'Class;
type Any_Root_Ptr is access all Any_Root;
type Even_Container is new Root with record
Tracker : Even_Tracker;
end record;
type Odd_Container is new Root with record
Tracker : Odd_Tracker;
end record;
task type Allocator is
entry Create (Even_Kind : Boolean);
end Allocator;
type Allocator_Array is array (1 .. Max_Tasks) of Allocator;
task body Allocator is
begin
select
accept Create (Even_Kind : Boolean) do
declare
Temp : Any_Root_Ptr;
begin
if Even_Kind then
Temp := Any_Root_Ptr'(new Even_Container);
else
Temp := Any_Root_Ptr'(new Odd_Container);
end if;
end;
end Create;
or
terminate;
end select;
end Allocator;
Allocators : Allocator_Array;
begin
for Index in 1 .. Max_Tasks loop
Allocators (Index).Create (Index mod 2 = 0);
end loop;
end;
if Even_Count /= Expected then
Put_Line ("ERROR: even count is off");
Put_Line (" got:" & Even_Count'Img);
Put_Line (" exp:" & Expected'Img);
end if;
if Odd_Count /= Expected then
Put_Line ("ERROR: odd count is off");
Put_Line (" got:" & Odd_Count'Img);
Put_Line (" exp:" & Expected'Img);
end if;
end Main;
-------------------------------
-- Compilation and execution --
-------------------------------
gnatmake -q -gnat05 main.adb
main
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-05 Hristian Kirtchev <[email protected]>
* s-finmas.adb (Set_Finalize_Address): Explain the reason
for the synchronization. Move the test for null from
s-stposu.Allocate_Any_Controlled to this routine since the check
needs to be protected too.
(Set_Heterogeneous_Finalize_Address): Explain the reason for the
synchronization code.
* s-finmas.ads (Set_Heterogeneous_Finalize_Address): Add comment
explaining the context in which this routine is used.
* s-stposu.adb (Allocate_Any_Controlled): Move the test for null
to s-finmas.Set_Finalize_Address.
Index: s-stposu.adb
===================================================================
--- s-stposu.adb (revision 178550)
+++ s-stposu.adb (working copy)
@@ -276,9 +276,7 @@
-- 3) Most cases of anonymous access types usage
if Master.Is_Homogeneous then
- if Finalize_Address (Master.all) = null then
- Set_Finalize_Address (Master.all, Fin_Address);
- end if;
+ Set_Finalize_Address (Master.all, Fin_Address);
-- Heterogeneous masters service the following:
Index: s-finmas.adb
===================================================================
--- s-finmas.adb (revision 178550)
+++ s-finmas.adb (working copy)
@@ -463,8 +463,17 @@
Fin_Addr_Ptr : Finalize_Address_Ptr)
is
begin
+ -- TSS primitive Finalize_Address is set at the point of allocation,
+ -- either through Allocate_Any_Controlled or through this routine.
+ -- Since multiple tasks can allocate on the same finalization master,
+ -- access to this attribute must be protected.
+
Lock_Task.all;
- Master.Finalize_Address := Fin_Addr_Ptr;
+
+ if Master.Finalize_Address = null then
+ Master.Finalize_Address := Fin_Addr_Ptr;
+ end if;
+
Unlock_Task.all;
end Set_Finalize_Address;
@@ -477,6 +486,9 @@
Fin_Addr_Ptr : Finalize_Address_Ptr)
is
begin
+ -- Protected access is required in this case because
+ -- Finalize_Address_Table is a global data structure.
+
Lock_Task.all;
Finalize_Address_Table.Set (Obj, Fin_Addr_Ptr);
Unlock_Task.all;
Index: s-finmas.ads
===================================================================
--- s-finmas.ads (revision 178550)
+++ s-finmas.ads (working copy)
@@ -124,7 +124,10 @@
procedure Set_Heterogeneous_Finalize_Address
(Obj : System.Address;
Fin_Addr_Ptr : Finalize_Address_Ptr);
- -- Add a relation pair object - Finalize_Address to the internal hash table
+ -- Add a relation pair object - Finalize_Address to the internal hash
+ -- table. This is done in the context of allocation on a heterogeneous
+ -- finalization master where a single master services multiple anonymous
+ -- access-to-controlled types.
procedure Set_Is_Heterogeneous (Master : in out Finalization_Master);
-- Mark the master as being a heterogeneous collection of objects
