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
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Test::FailWarnings;
use FindBin;
use blib "$FindBin::Bin/../lib";
use Promise::XS;
{
my $destroyed = 0;
my $d = Promise::XS::deferred();
my $p = do {
my $obj = OnDestroy->new( sub {
$destroyed++;
} );
$d->promise()->finally( sub { $obj } );
};
is( $destroyed, 0, 'promise is alive: reference isn’t reaped' );
undef $d;
undef $p;
is( $destroyed, 1, 'promise is gone: reference is reaped' );
}
{
my $destroyed = 0;
my $d = Promise::XS::deferred();
my $p = do {
my $obj = OnDestroy->new( sub {
$destroyed++;
} );
$d->promise()->finally( sub { $obj } );
};
$p = $p->catch( sub {} );
is( $destroyed, 0, 'promise is alive: reference isn’t reaped' );
undef $d;
undef $p;
is( $destroyed, 1, 'promise is gone: reference is reaped' );
}
done_testing;
#----------------------------------------------------------------------
package OnDestroy;
sub new { return bless [ $_[1] ], $_[0] }
sub DESTROY {
defined(${^GLOBAL_PHASE}) && print "DESTROYING at ${^GLOBAL_PHASE}$/";
$_[0][0]->();
}
1;
|
