OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gnat.dg/] [entry_queues.adb] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 696 jeremybenn
-- { 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.