File: reenter.t

package info (click to toggle)
libevent-perl 1.06-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 712 kB
  • ctags: 588
  • sloc: ansic: 3,020; perl: 1,128; makefile: 46
file content (49 lines) | stat: -rw-r--r-- 894 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
# deep -*- perl -*-
BEGIN {
    if ($^O eq 'MSWin32') {
	print "1..0\n";
	print "ok 1 # skipped; Win32 supports select() only on sockets\n";
	exit;
    }
}

use Test; plan test => 7;
use Event qw(loop unloop one_event all_running);

#$Event::DebugLevel = 4;

# deep recursion
my $rep;
$rep = Event->io(fd => \*STDOUT, poll => 'w', cb => sub { loop() });
do {
    local $SIG{__WARN__} = sub {};  # COMMENT OUT WHEN DEBUGGING!
    ok !defined loop();
};
ok $rep->is_running, 0;


# simple nested case
my $nest=0;
$rep->cb(sub {
    return if ++$nest > 10;
    one_event();
});
ok one_event();


# a bit more complex nested exception
$nest=0;
$rep->cb(sub {
    die 10 if ++$nest > 10;
    one_event() or die "not recursing";
});
$Event::DIED = sub {
    my $e = shift;
    ok $e->w, $rep;
    ok $e->w, all_running();
    my @all = all_running;
    ok @all, $nest;
    unloop();
};
loop();
ok 1;