gcc/testsuite/gnat.dg/entry_queues.adb

   1 -- { dg-do run }
   2 -- { dg-options "-gnatws" }
   3
   4 procedure entry_queues is
   5   F1_Poe : Integer := 18;
   6   function F1 return Integer is
   7   begin
   8     F1_Poe := F1_Poe - 1;
   9     return F1_Poe;
  10   end F1;
  11   generic
  12     type T is limited private;
  13     with function Is_Ok (X : T) return Boolean;
  14   procedure Check;
  15   procedure Check is
  16   begin
  17     declare
  18       type Poe is new T;
  19       X : Poe;
  20       Y : Poe;
  21     begin
  22       null;
  23     end;
  24     declare
  25       type Poe is new T;
  26       type Arr is array (1 .. 2) of Poe;
  27       X : Arr;
  28       B : Boolean := Is_Ok (T (X (1)));
  29     begin
  30       null;
  31     end;
  32   end;
  33   protected type Poe (D3 : Integer := F1) is
  34     entry E (D3 .. F1);    -- F1 evaluated
  35     function Is_Ok return Boolean;
  36   end Poe;
  37   protected body Poe is
  38     Entry E (for I in D3 .. F1) when True is
  39     begin
  40       null;
  41     end E;
  42     function Is_Ok return Boolean is
  43     begin
  44       return False;
  45     end Is_Ok;
  46   end Poe;
  47   function Is_Ok (C : Poe) return Boolean is
  48   begin
  49     return C.Is_Ok;
  50   end Is_Ok;
  51   procedure Chk is new Check (Poe, Is_Ok);
  52 begin
  53    Chk;
  54 end;