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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 696 jeremybenn
--  { dg-do run }
2
 
3
with Ada.Text_Io; use Ada.Text_Io;
4
 
5
procedure requeue1 is
6
 
7
  protected P is
8
    entry Requeue_Without_Abort;
9
    entry Queue_Without;
10
    procedure Open;
11
  private
12
    Opened: Boolean := False;
13
  end P;
14
 
15
  protected body P is
16
    entry Requeue_Without_Abort when True is
17
    begin
18
      -- BUG: after this requeue no time out of the call should be possible
19
      requeue Queue_Without;
20
    end Requeue_Without_Abort;
21
 
22
    entry Queue_Without when Opened is
23
    begin
24
      Opened := False;
25
    end Queue_Without;
26
 
27
    procedure Open is
28
    begin
29
      Opened := True;
30
    end Open;
31
  end P;
32
 
33
  -- Test of timed entry call to an entry with requeue without abort
34
  task T_Without;
35
  task body T_Without is
36
  begin
37
    select
38
      P.Requeue_Without_Abort;
39
    or
40
      delay 1.0;
41
      Put_Line("failed");
42
    end select;
43
 
44
  exception
45
    when others => Put_Line ("failed");
46
  end T_Without;
47
 
48
begin
49
  delay 3.0;
50
  P.Open;
51
end;

powered by: WebSVN 2.1.0

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