Re: ATC, an example please.

[Craig Carey <research@ijs.co.nz>]

On 30 Jun 2005 01:44:52 -0700, "e.coli" wrote:

>How [does] ATC work?
>Can you fix this example, please?.


with Ada.Text_IO;
with Ada.Characters.Handling;
with Ada.Exceptions;


procedure ATC_Test is
      --  If compile with gnatmake in Windows, use "-gnatP" polling

   package Tio renames Ada.Text_IO;
   package ACH renames Ada.Characters.Handling;

   procedure Put (X : String) renames Tio.Put;
   procedure PutL (X : String) renames Tio.Put_Line;


   procedure Slave;                 --  This procedure gets interrupted
   procedure Slave is
   begin
            --  Seeming GNAT 3.15p NT bug: Abort_Defer kills the delay
            --  statement (as well as blocking the abort as expected):
      --  pragma Abort_Defer;
      PutL ("Slave starts");
      for Iteration in 1 .. 1_000 loop
         Put (".");
         delay 0.100;
      end loop;
      PutL (ASCII.LF & "Slave ends by itself");
   end Slave;


   task type Keyboard_Task_Type is
      entry Got_Quit_Key;
   end Keyboard_Task_Type;

   type Keyboard_Task_Type_AP is access all Keyboard_Task_Type;

   task body Keyboard_Task_Type
   is
      Ch       : Character;
   begin
      PutL ("Keyboard task starts");
      loop
         Tio.Get_Immediate (Item => Ch);
         Ch := ACH.To_Lower (String'(1 => Ch)) (1);
         PutL (" """ & Ch & '"');
         if Ch = 'q' then
            accept Got_Quit_Key;
            exit;
         end if;
      end loop;
      PutL ("Keyboard task ends");
   exception
      when others => null;
   end Keyboard_Task_Type;


   task type Interruptible_Task is
      entry Start (KT_In : Keyboard_Task_Type_AP);
   end Interruptible_Task;

   task body Interruptible_Task
   is
      KT    : Keyboard_Task_Type_AP;
   begin
      PutL ("Interruptible task starts");
      accept Start (KT_In : Keyboard_Task_Type_AP) do
         KT := KT_In;
      end Start;
      <<REDO>>
      select         --  No aborting when not inside a task
         KT.all.Got_Quit_Key;       --  Now KT maybe becomes unusable
         PutL ("Computation aborted");
      then abort
         PutL ("Starting computation. Press Q to quit");
         Slave;
         PutL ("Finished computation without abrting");
      end select;
      --  goto REDO;             --  If a loop around the select, then
   exception                     --  a "Tasking_Error" error occurs
      when E : others =>         --  when a terminated KT task is used
         PutL ("Interruptible_Task: " &      -- GNAT hides error
                  Ada.Exceptions.Exception_Information (E));
   end Interruptible_Task;

begin
   declare
      KT    : aliased Keyboard_Task_Type;
      IT    : Interruptible_Task;
   begin
      IT.Start (KT_In => KT'Unchecked_Access);
   end;                          --  First declared is last finalized
   PutL ("Main program ends");
end ATC_Test;

% Compiled and run. Only tested in Windows 2003.

$ gnatmake atc_test.adb -gnatP -gnata -gnato -gnatq -O0 -g -gnatf
  -gnatU -m -i -gnatwacfHlpru -gnatR3s -gnaty3abcefhiklM79nprt
  -bargs -E -p -we -s -static -largs -v -v

$ atc_test.exe
---------------------------------------
Keyboard task starts
Interruptible task starts
Starting computation. Press Q to quit
Slave starts
.............. "y"
........ "q"
Keyboard task ends
Computation aborted
Main program ends
---------------------------------------

Perhaps experts (e.g. Mr Obry) can say why GNAT 3.15p ATC:
 (a) only runs inside a task, and/or
 (b) what's up with Abort_Defer feature of disabling the delay statement?.


Craig Carey
Auckland