agpl_1.0.0_b5da3320/src/agpl-task_termination.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
with Agpl.Text_Io; use Agpl.Text_Io;
with Agpl.Trace; use Agpl.Trace;

with Ada.Exceptions;          use Ada.Exceptions;
with Ada.Task_Identification; use Ada.Task_Identification;
with Ada.Task_Termination;    use Ada.Task_Termination;

package body Agpl.Task_Termination is

   protected Object is

      procedure Grim_Reaper (Cause : Cause_Of_Termination;
                             T     : Ada.Task_Identification.Task_Id;
                             X     : Ada.Exceptions.Exception_Occurrence);

   end Object;

   protected body Object is
      procedure Grim_Reaper (Cause : Cause_Of_Termination;
                             T     : Ada.Task_Identification.Task_Id;
                             X     : Ada.Exceptions.Exception_Occurrence)
      is
         Levels : constant array (Cause_Of_Termination) of Trace.Levels :=
                    (Normal => Debug, others => Error);
      begin
         Log ("Grim reaper: Task [" & Image (T) & "] finished with cause " &
              Cause_Of_Termination'Image (Cause),
              Levels (Cause), Log_Section);
         if Cause = Unhandled_Exception then
            Put_Line ("Grim reaper: Task [" & Image (T) & "] exception was " &
              Trace.Report (X));
            Log ("Grim reaper: Task [" & Image (T) & "] exception was " &
              Trace.Report (X),
              Levels (Cause), Log_Section);
         end if;
      end Grim_Reaper;
   end Object;

begin
   Set_Dependents_Fallback_Handler (Object.Grim_Reaper'Access);
end Agpl.Task_Termination;