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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gnat.dg/] [discr17.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 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;

powered by: WebSVN 2.1.0

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