This change implements a new feature in the tasking runtime library: if Unchecked_Deallocation is called on a non-terminated task (which was previously a no-op), the task is now marked to be freed automatically when it terminates.
The following test case demonstrates the feature: $ gnatmake -q -z free_nonterm_task When executing free_nonterm_task under valgrind, no memory leak corresponding to the creation of task T (in System.Tasking.Stages.Create_Task) shall be reported. package Free_Nonterm_Task is pragma Elaborate_Body; end Free_Nonterm_Task; with Ada.Unchecked_Deallocation; with Ada.Text_IO; use Ada.Text_IO; package body Free_Nonterm_Task is type T; type A is access T; task type T is entry Term (Self : in out A); end T; procedure Free is new Ada.Unchecked_Deallocation (T, A); task body T is begin Put_Line ("T: enter"); accept Term (Self : in out A) do Free (Self); end Term; Put_Line ("T: exit"); end T; My_Task : A; begin Put_Line ("Create task"); My_Task := new T; Put_Line ("Call Term"); My_Task.Term (My_Task); end Free_Nonterm_Task; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-06 Thomas Quinot <qui...@adacore.com> * s-tassta.adb, s-taskin.ads (Free_Task): If the task is not terminated, mark it for deallocation upon termination. (Terminate_Task): Call Free_Task again if the task is marked for automatic deallocation upon termination.
Index: s-tassta.adb =================================================================== --- s-tassta.adb (revision 178565) +++ s-tassta.adb (working copy) @@ -969,12 +969,11 @@ Free_Entry_Names (T); System.Task_Primitives.Operations.Finalize_TCB (T); - -- If the task is not terminated, then we simply ignore the call. This - -- happens when a user program attempts an unchecked deallocation on - -- a non-terminated task. + else + -- If the task is not terminated, then mark the task as to be freed + -- upon termination. - else - null; + T.Free_On_Termination := True; end if; end Free_Task; @@ -1429,6 +1428,7 @@ procedure Terminate_Task (Self_ID : Task_Id) is Environment_Task : constant Task_Id := STPO.Environment_Task; Master_of_Task : Integer; + Deallocate : Boolean; begin Debug.Task_Termination_Hook; @@ -1474,6 +1474,7 @@ Stack_Guard (Self_ID, False); Utilities.Make_Passive (Self_ID, Task_Completed => True); + Deallocate := Self_ID.Free_On_Termination; if Single_Lock then Unlock_RTS; @@ -1485,8 +1486,13 @@ Initialization.Final_Task_Unlock (Self_ID); -- WARNING: past this point, this thread must assume that the ATCB has - -- been deallocated. It should not be accessed again. + -- been deallocated, and can't access it anymore (which is why we have + -- saved the Free_On_Termination flag in a temporary variable). + if Deallocate then + Free_Task (Self_ID); + end if; + if Master_of_Task > 0 then STPO.Exit_Task; end if; Index: s-taskin.ads =================================================================== --- s-taskin.ads (revision 178565) +++ s-taskin.ads (working copy) @@ -1150,6 +1150,12 @@ -- -- Protection: Self.L. Once a task has set Self.Stage to Completing, it -- has exclusive access to this field. + + Free_On_Termination : Boolean := False; + -- Deallocate the ATCB when the task terminates. This flag is normally + -- False, and is set True when Unchecked_Deallocation is called on a + -- non-terminated task so that the associated storage is automatically + -- reclaimed when the task terminates. end record; --------------------