===================================================================
@@ -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:
===================================================================
@@ -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;
===================================================================
@@ -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
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 <kirtchev@adacore.com> * 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.