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
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Refcount;
use Test::Builder::Tester;
use Future;
use Test::Future;
# pass
{
test_out( "ok 1 - immediate Future" );
my $ran_code;
no_pending_futures {
$ran_code++;
Future->done(1,2,3);
} 'immediate Future';
test_test( "immediate Future passes" );
ok( $ran_code, 'actually ran the code' );
}
# fail
{
test_out( "not ok 1 - pending Future" );
test_fail( +8 );
test_err( "# The following Futures are still pending:" );
test_err( qr/^# 0x[0-9a-f]+\n/ );
test_err( qr/^# Writing heap dump to \S+\n/ ) if Test::Future::HAVE_DEVEL_MAT_DUMPER;
my $f;
no_pending_futures {
$f = Future->new;
} 'pending Future';
test_test( "pending Future fails" );
$f->cancel;
}
# does not retain Futures
{
test_out( "ok 1 - refcount 2 before drop" );
test_out( "ok 2 - refcount 1 after drop" );
test_out( "ok 3 - retain" );
no_pending_futures {
my $arr = [1,2,3];
my $f = Future->new;
$f->done( $arr );
is_refcount( $arr, 2, 'refcount 2 before drop' );
undef $f;
is_refcount( $arr, 1, 'refcount 1 after drop' );
} 'retain';
test_test( "no_pending_futures does not retain completed Futures" );
}
# does not retain immedate Futures
{
test_out( "ok 1 - refcount 2 before drop" );
test_out( "ok 2 - refcount 1 after drop" );
test_out( "ok 3 - retain" );
no_pending_futures {
my $arr = [1,2,3];
my $f = Future->done( $arr );
is_refcount( $arr, 2, 'refcount 2 before drop' );
undef $f;
is_refcount( $arr, 1, 'refcount 1 after drop' );
} 'retain';
test_test( "no_pending_futures does not retain immediate Futures" );
}
END {
# Clean up Devel::MAT dumpfile
my $pmat = $0;
$pmat =~ s/\.t$/-1.pmat/;
unlink $pmat if -f $pmat;
}
done_testing;
|
