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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
use v5.10;
use strict;
use warnings;
use Test2::V0;
use Time::HiRes qw( gettimeofday tv_interval );
BEGIN {
$ENV{PERL_FUTURE_DEBUG} = 1;
Future::XS::reread_environment() if defined &Future::XS::reread_environment;
}
use Future;
my $FILE = __FILE__;
$FILE = qr/\Q$FILE\E/;
my $LINE;
my $LOSTLINE;
sub warnings_from(&)
{
my $code = shift;
my $warnings = "";
local $SIG{__WARN__} = sub { $warnings .= shift };
$code->();
$LOSTLINE = __LINE__; return $warnings;
}
is( warnings_from {
my $f = Future->new;
$f->done;
}, "", 'Completed Future does not give warning' );
is( warnings_from {
my $f = Future->new;
$f->cancel;
}, "", 'Cancelled Future does not give warning' );
like( warnings_from {
$LINE = __LINE__; my $f = Future->new;
undef $f;
},
qr/^Future=\S+ was constructed at $FILE line $LINE and was lost near $FILE line (?:$LOSTLINE|${\($LINE+1)}) before it was ready\.?$/,
'Lost Future raises a warning' );
my $THENLINE;
my $SEQLINE;
like( warnings_from {
$LINE = __LINE__; my $f1 = Future->new;
$THENLINE = __LINE__; my $fseq = $f1->then( sub { } ); undef $fseq;
$SEQLINE = __LINE__; $f1->done;
},
qr/^Future=\S+ was constructed at $FILE line $THENLINE and was lost near $FILE line (?:$SEQLINE|$THENLINE) before it was ready\.?
Future=\S+ \(constructed at $FILE line $LINE\) lost a sequence Future at $FILE line $SEQLINE\.?$/,
'Lost sequence Future raises warning' );
like( warnings_from {
$LINE = __LINE__; my $f = Future->fail("Failed!");
undef $f;
},
qr/^Future=\S+ was constructed at $FILE line $LINE and was lost near $FILE line (?:$LOSTLINE|${\($LINE+1)}) with an unreported failure of: Failed!\.?/,
'Destroyed failed future raises warning' );
{
$Future::TIMES or
BAIL_OUT( "Need to set \$Future::TIMES = 1" );
my $before = [ gettimeofday ];
my $future = Future->new;
ok( defined $future->btime, '$future has btime with $TIMES=1' );
ok( tv_interval( $before, $future->btime ) >= 0, '$future btime is not earlier than $before' );
$future->done;
ok( defined $future->rtime, '$future has rtime with $TIMES=1' );
ok( tv_interval( $future->btime, $future->rtime ) >= 0, '$future rtime is not earlier than btime' );
ok( tv_interval( $future->rtime ) >= 0, '$future rtime is not later than now' );
ok( defined $future->elapsed, '$future has ->elapsed time' );
ok( $future->elapsed >= 0, '$future elapsed time >= 0' );
my $imm = Future->done;
ok( defined $imm->rtime, 'Immediate future has rtime' );
ok( defined $imm->elapsed, 'Immediate future has ->elapsed time' );
ok( $imm->elapsed >= 0, 'Immediate future elapsed time >= 0' );
}
done_testing;
|
