gcc/testsuite/gnat.dg/discr17.adb

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