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;
--------------------
