gcc/testsuite/gnat.dg/requeue1.adb

   1 --  { dg-do run }
   2
   3 with Ada.Text_Io; use Ada.Text_Io;
   4
   5 procedure requeue1 is
   6
   7   protected P is
   8     entry Requeue_Without_Abort;
   9     entry Queue_Without;
  10     procedure Open;
  11   private
  12     Opened: Boolean := False;
  13   end P;
  14
  15   protected body P is
  16     entry Requeue_Without_Abort when True is
  17     begin
  18       -- BUG: after this requeue no time out of the call should be possible
  19       requeue Queue_Without;
  20     end Requeue_Without_Abort;
  21
  22     entry Queue_Without when Opened is
  23     begin
  24       Opened := False;
  25     end Queue_Without;
  26
  27     procedure Open is
  28     begin
  29       Opened := True;
  30     end Open;
  31   end P;
  32
  33   -- Test of timed entry call to an entry with requeue without abort
  34   task T_Without;
  35   task body T_Without is
  36   begin
  37     select
  38       P.Requeue_Without_Abort;
  39     or
  40       delay 1.0;
  41       Put_Line("failed");
  42     end select;
  43
  44   exception
  45     when others => Put_Line ("failed");
  46   end T_Without;
  47
  48 begin
  49   delay 3.0;
  50   P.Open;
  51 end;