gdb/testsuite/gdb.ada/rdv_wait/foo.adb

   1 --  Copyright 2012-2023 Free Software Foundation, Inc.
   2 --
   3 --  This program is free software; you can redistribute it and/or modify
   4 --  it under the terms of the GNU General Public License as published by
   5 --  the Free Software Foundation; either version 3 of the License, or
   6 --  (at your option) any later version.
   7 --
   8 --  This program is distributed in the hope that it will be useful,
   9 --  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 --  GNU General Public License for more details.
  12 --
  13 --  You should have received a copy of the GNU General Public License
  14 --  along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 with Pck; use Pck;
  17
  18 procedure Foo is
  19
  20    task type T is
  21       entry Finish;
  22    end T;
  23    type TA is access T;
  24
  25    task body T is
  26    begin
  27       --  Wait for up to 100 seconds for the Finish Rendez-Vous to occur.
  28       select
  29          accept Finish do
  30             null;
  31          end Finish;
  32       or
  33          delay 100.0;
  34       end select;
  35    end T;
  36
  37    MIT : TA;
  38
  39 begin
  40
  41    --  Create a task, and give it some time to activate and then start
  42    --  its execution.
  43    MIT := new T;
  44    delay 0.01;
  45
  46    --  Now, call our anchor. The task we just created should now be
  47    --  blocked on a timed entry wait.
  48    Break_Me;
  49
  50    --  Tell the task to finish before the 100 seconds are up.  The test
  51    --  is now finished, no need to wait :).
  52    MIT.Finish;
  53 end Foo;