From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Thread: 103376,3b69de4361f731f1
X-Google-Attributes: gid103376,public
X-Google-Language: ENGLISH,ASCII-7-bit
Path: 
 g2news1.google.com!news3.google.com!news.glorb.com!border1.nntp.dca.giganews.com!nntp.giganews.com!local01.nntp.dca.giganews.com!nntp.clear.net.nz!news.clear.net.nz.POSTED!not-for-mail
NNTP-Posting-Date: Sat, 02 Jul 2005 03:18:38 -0500
From: Craig Carey <research@ijs.co.nz>
Newsgroups: comp.lang.ada
Subject: Re: ATC, an  example please.
Date: Sat, 02 Jul 2005 20:18:32 +1200
Message-ID: <2cjcc1d1bhoba0lf12k17c4ddmtoq4fsbr@4ax.com>
References: <1120121092.240284.285260@g14g2000cwa.googlegroups.com>
X-Newsreader: Forte Agent 2.0/32.652
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
X-Original-NNTP-Posting-Host: ip-210-185-6-118.internet.co.nz
X-Original-Trace: 2 Jul 2005 21:10:09 +1200, ip-210-185-6-118.internet.co.nz
Organization: "ICONZ Ltd."
X-Original-NNTP-Posting-Host: news.nz.asiaonline.net
X-Original-Trace: 2 Jul 2005 20:18:33 +1200, news.nz.asiaonline.net
NNTP-Posting-Host: 203.97.37.6
X-Trace: 
 sv3-5M1wmG7H/dyM7mKtf/UZEg/zBz+8cpOyUwmjfV+kLaoYDjLelTgdsL10yEQ8gkEkHc3WRskvqt4OvoH!OeOUBP/pzeeMWlUWVmkGR1JUuo77n5u+wZfzJgzB+TzbSZKHLj3yDYDxB9bM31YYqOZZjXcNKHFG!Pko6J4A=
X-Complaints-To: Complaints to abuse@clear.net.nz
X-DMCA-Complaints-To: Complaints to abuse@clear.net.nz
X-Abuse-and-DMCA-Info: Please be sure to forward a copy of ALL headers
X-Abuse-and-DMCA-Info: Otherwise we will be unable to process your complaint
 properly
X-Postfilter: 1.3.32
Xref: g2news1.google.com comp.lang.ada:11829
Date: 2005-07-02T20:18:32+12:00
List-Id: <comp.lang.ada>

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