[Ada] Requeue with abort from a timed-out entry call.

[Ada] Requeue with abort from a timed-out entry call.

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 2303 bytes --]

A requeue allows an accept statement to be completed by a different entry
call, possibly on a different task. If the requeue is abortable, it may
time out while queued on the second task, in which case the original timed
entry call must be aborted. This path handles the unusual case where the
timeout occurs before the requeue has taken place, when the accept statement
itself exceeds the specified delay. This case must be detected before the
requeue takes place, and handled like a conditional entry call, to prevent
arbitrarily long delays.

Execution of timed_entry_call below must produce the following output:

Round 1
E1 accepted
E1 requeued
First time aborting because E2 not ready
E2 ready
E2 accepted
E2 done

Round 2
E1 accepted
E1 requeued
E2 accepted
E1 done

Done

--
with Ada.Text_IO;
use  Ada.Text_IO;

procedure Timed_Entry_Call is

  task Server is
    entry E1;
  end Server;

  task Hidden is
    entry Start;
    entry E2;
  end Hidden;

  task W;

  task body W is
  begin
    Hidden.E2;
    Put_Line ("E2 done");
  end W;

  task body Server is
  begin
    loop
      accept E1 do
        Put_Line ("E1 accepted");
        delay 3.0;  -- (1) do some work that takes longer than client's patience
        Put_Line ("E1 requeued");
        requeue Hidden.E2 with abort;
      end E1;
    end loop;
  end Server;

  task body Hidden is
  begin
    accept Start;
    Put_Line ("E2 ready");
    loop
      accept E2 do
        Put_Line ("E2 accepted");
      end E2;
    end loop;
  end Hidden;

begin

  for I in 1 .. 2 loop

    Put_Line ("Round" & Integer'Image (I));

    select
      Server.E1;  -- E1 is ready for rendezvous
      Put_Line ("E1 done");
    or
      delay 1.0;  -- (2)
      Put_Line ("First time aborting because E2 not ready");
      Hidden.Start;  -- Make E2 ready for second time
    end select;

    delay 1.0;

    New_Line;

  end loop;

  Put_Line ("Done");

  abort Server, Hidden;

end Timed_Entry_Call;

Tested on x86_64-pc-linux-gnu, committed on trunk

2009-04-24  Ed Schonberg  <schonberg@adacore.com>

	* s-tasren.adb (Task_Do_Or_Queue): If a timed entry call is being
	requeued and the delay has expired while within the accept statement
	that executes the requeue, do not perform the requeue and indicate that
	the timed call has been aborted.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1999 bytes --]

Index: s-tasren.adb
===================================================================
--- s-tasren.adb	(revision 146680)
+++ s-tasren.adb	(working copy)
@@ -1225,9 +1225,31 @@ package body System.Tasking.Rendezvous i
       --  we would not have gotten this far, so now we should
       --  (re)enqueue the call, if the mode permits that.
 
-      if Entry_Call.Mode /= Conditional_Call
-        or else not Entry_Call.With_Abort
+      --  If the call is timed, it may have timed out before the requeue,
+      --  in the unusual case where the current accept has taken longer than
+      --  the given delay. In that case the requeue is cancelled, and the
+      --  outer timed call will be aborted.
+
+      if Entry_Call.Mode = Conditional_Call
+        or else
+          (Entry_Call.Mode = Timed_Call
+            and then Entry_Call.With_Abort
+            and then Entry_Call.Cancellation_Attempted)
       then
+         STPO.Unlock (Acceptor);
+
+         if Parent_Locked then
+            STPO.Unlock (Parent);
+         end if;
+
+         STPO.Write_Lock (Entry_Call.Self);
+
+         pragma Assert (Entry_Call.State >= Was_Abortable);
+
+         Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
+         STPO.Unlock (Entry_Call.Self);
+
+      else
          --  Timed_Call, Simple_Call, or Asynchronous_Call
 
          Queuing.Enqueue (Acceptor.Entry_Queues (E), Entry_Call);
@@ -1266,22 +1288,6 @@ package body System.Tasking.Rendezvous i
 
             STPO.Unlock (Entry_Call.Self);
          end if;
-
-      else
-         --  Conditional_Call and With_Abort
-
-         STPO.Unlock (Acceptor);
-
-         if Parent_Locked then
-            STPO.Unlock (Parent);
-         end if;
-
-         STPO.Write_Lock (Entry_Call.Self);
-
-         pragma Assert (Entry_Call.State >= Was_Abortable);
-
-         Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
-         STPO.Unlock (Entry_Call.Self);
       end if;
 
       return True;