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
|
#!perl -w
use strict;
use Test::Requires qw(Test::LeakTrace);
use Test::More;
use warnings FATAL => 'all';
use Data::Clone;
{
package MyBase;
sub new {
my $class = shift;
return bless {@_}, $class;
}
package MyNoclonable;
our @ISA = qw(MyBase);
package MyClonable;
use Data::Clone;
our @ISA = qw(MyBase);
package MyCustomClonable;
use Data::Clone qw(data_clone);
our @ISA = qw(MyBase);
sub clone {
my $cloned = data_clone(@_);
$cloned->{bar} = 42;
return $cloned;
}
package FatalClonable;
use Data::Clone qw(data_clone);
our @ISA = qw(MyBase);
sub clone {
my $cloned = data_clone(@_);
die 'FATAL';
}
}
no_leaks_ok {
my $o = [ 42 ];
my $c = clone($o);
} or die "Memory leaked";
no_leaks_ok {
local $Data::Clone::ObjectCallback = sub{ $_[0] };
my $o = MyNoclonable->new(foo => 10);
my $c = clone($o);
};
no_leaks_ok {
my $o = MyClonable->new(foo => 20);
my $c = clone($o);
};
no_leaks_ok {
my $o = MyCustomClonable->new(foo => 30);
my $c = clone($o);
};
no_leaks_ok {
my $o = MyCustomClonable->new(foo => MyClonable->new(bar => 42));
my $c = clone($o);
};
no_leaks_ok {
my $o = FatalClonable->new(value => MyClonable->new(foo => 50));
eval{ clone($o) };
} 'fatal in clone()';
done_testing;
|
