gcc/testsuite/gnat.dg/entry1.adb

   1 --  { dg-do compile }
   2 --  { dg-options "-gnateF" }
   3
   4 PACKAGE BODY Entry1 IS
   5
   6    PROTECTED TYPE key_buffer IS
   7
   8       PROCEDURE clear;
   9
  10       ENTRY incr;
  11       ENTRY put (val : IN Natural);
  12       ENTRY get (val : OUT Natural);
  13
  14    PRIVATE
  15
  16       -- Stores Key states (key state controller)
  17       -- purpose: exclusive access
  18       max_len : Natural := 10;
  19
  20       cnt : Natural := 0;
  21
  22    END key_buffer;
  23
  24    PROTECTED BODY key_buffer IS
  25
  26       PROCEDURE clear IS
  27       BEGIN
  28          cnt := 0;
  29       END clear;
  30
  31       ENTRY incr WHEN cnt < max_len IS
  32       BEGIN
  33          cnt := cnt + 1;
  34       END;
  35
  36       ENTRY put (val : IN Natural) WHEN cnt < max_len IS
  37       BEGIN
  38          cnt := val;
  39       END put;
  40
  41       ENTRY get (val : OUT Natural) WHEN cnt > 0 IS
  42       BEGIN
  43          val := cnt;
  44       END get;
  45
  46    END key_buffer;
  47
  48    my_buffer : key_buffer;
  49
  50    FUNCTION pt2 (t : IN Float) RETURN Natural IS
  51       c : Natural;
  52       t2 : duration := duration (t);
  53    BEGIN
  54       SELECT
  55          my_buffer.get (c);
  56          RETURN c;
  57       OR
  58          DELAY t2;
  59          RETURN 0;
  60       END SELECT;
  61    END pt2;
  62
  63    FUNCTION pt (t : IN Float) RETURN Natural IS
  64       c : Natural;
  65    BEGIN
  66       SELECT
  67          my_buffer.get (c);
  68          RETURN c;
  69       OR
  70          DELAY Duration (t);
  71          RETURN 0;
  72       END SELECT;
  73    END pt;
  74
  75 END Entry1;