File Coverage

blib/lib/Test/Refcount.pm
Criterion Covered Total %
statement 48 48 100.0
branch 4 4 100.0
condition n/a
subroutine 10 10 100.0
pod 3 3 100.0
total 65 65 100.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2008-2019 -- leonerd@leonerd.org.uk
5              
6             package Test::Refcount;
7              
8 5     5   277843 use strict;
  5         30  
  5         141  
9 5     5   27 use warnings;
  5         9  
  5         142  
10 5     5   27 use base qw( Test::Builder::Module );
  5         8  
  5         788  
11              
12 5     5   37 use Scalar::Util qw( weaken refaddr );
  5         12  
  5         316  
13 5     5   34 use B qw( svref_2object );
  5         8  
  5         582  
14              
15             our $VERSION = '0.09';
16              
17             our @EXPORT = qw(
18             is_refcount
19             is_oneref
20             );
21              
22             our @EXPORT_OK = qw(
23             refcount
24             );
25              
26 5     5   48 use constant HAVE_DEVEL_FINDREF => defined eval { require Devel::FindRef };
  5         9  
  5         8  
  5         1400  
27 5     5   28 use constant HAVE_DEVEL_MAT_DUMPER => defined eval { require Devel::MAT::Dumper };
  5         9  
  5         8  
  5         2139  
28              
29             =encoding UTF-8
30              
31             =head1 NAME
32              
33             C - assert reference counts on objects
34              
35             =head1 SYNOPSIS
36              
37             use Test::More tests => 2;
38             use Test::Refcount;
39              
40             use Some::Class;
41              
42             my $object = Some::Class->new();
43              
44             is_oneref( $object, '$object has a refcount of 1' );
45              
46             my $otherref = $object;
47              
48             is_refcount( $object, 2, '$object now has 2 references' );
49              
50             =head1 DESCRIPTION
51              
52             The Perl garbage collector uses simple reference counting during the normal
53             execution of a program. This means that cycles or unweakened references in
54             other parts of code can keep an object around for longer than intended. To
55             help avoid this problem, the reference count of a new object from its class
56             constructor ought to be 1. This way, the caller can know the object will be
57             properly DESTROYed when it drops all of its references to it.
58              
59             This module provides two test functions to help ensure this property holds
60             for an object class, so as to be polite to its callers.
61              
62             If the assertion fails; that is, if the actual reference count is different to
63             what was expected, either of the following two modules may be used to assist
64             the developer in finding where the references are.
65              
66             =over 4
67              
68             =item *
69              
70             If L is installed, this test module will use it to dump the state
71             of the memory after a failure. It will create a F<.pmat> file named the same
72             as the unit test, but with the trailing F<.t> suffix replaced with
73             F<-TEST.pmat> where C is the number of the test that failed (in case
74             there was more than one).
75              
76             =item *
77              
78             If L module is installed, a reverse-references trace is
79             printed to the test output.
80              
81             =back
82              
83             See the examples below for more information.
84              
85             =cut
86              
87             =head1 FUNCTIONS
88              
89             =cut
90              
91             =head2 is_refcount
92              
93             is_refcount( $object, $count, $name )
94              
95             Test that $object has $count references to it.
96              
97             =cut
98              
99             sub is_refcount($$;$)
100             {
101 18     18 1 29605 my ( $object, $count, $name ) = @_;
102 18         39 @_ = ();
103              
104 18         103 my $tb = __PACKAGE__->builder;
105              
106 18 100       195 if( !ref $object ) {
107 1         11 my $ok = $tb->ok( 0, $name );
108 1         1080 $tb->diag( " expected a reference, was not given one" );
109 1         233 return $ok;
110             }
111              
112 17         79 weaken $object; # So this reference itself doesn't show up
113              
114 17         38 my $REFCNT = refcount( $object );
115              
116 17         60 my $ok = $tb->ok( $REFCNT == $count, $name );
117              
118 17 100       6905 unless( $ok ) {
119 3         22 $tb->diag( " expected $count references, found $REFCNT" );
120              
121 3         697 if( HAVE_DEVEL_MAT_DUMPER ) {
122 3         9 my $file = $0;
123 3         11 my $num = $tb->current_test;
124              
125             # Trim the .t off first then append -$num.pmat, in case $0 wasn't a .t file
126 3         332 $file =~ s/\.(?:t|pm|pl)$//;
127 3         13 $file .= "-$num\.pmat";
128              
129 3         30 $tb->diag( sprintf "SV address is 0x%x", refaddr $object );
130 3         688 $tb->diag( "Writing heap dump to $file" );
131 3         142579 Devel::MAT::Dumper::dump( $file );
132             }
133 3         34 if( HAVE_DEVEL_FINDREF ) {
134             $tb->diag( Devel::FindRef::track( $object ) );
135             }
136             }
137              
138 17         59 return $ok;
139             }
140              
141             =head2 is_oneref
142              
143             is_oneref( $object, $name )
144              
145             Assert that the $object has only 1 reference to it.
146              
147             =cut
148              
149             sub is_oneref($;$)
150             {
151 5     5 1 11029 splice( @_, 1, 0, ( 1 ) );
152 5         22 goto &is_refcount;
153             }
154              
155             =head2 refcount
156              
157             $count = refcount( $object )
158              
159             I
160              
161             Returns the reference count of the given object as used by the test functions.
162             This is useful for making tests that don't care what the count is before they
163             start, but simply assert that the count hasn't changed by the end.
164              
165             use Test::Refcount import => [qw( is_refcount refcount )];
166             {
167             my $count = refcount( $object );
168              
169             do_something( $object );
170              
171             is_refcount( $object, $count, 'do_something() preserves refcount' );
172             }
173              
174             =cut
175              
176             sub refcount
177             {
178 17     17 1 165 return svref_2object( $_[0] )->REFCNT;
179             }
180              
181             =head1 EXAMPLE
182              
183             Suppose, having written a new class C, you now want to check that its
184             constructor and methods are well-behaved, and don't leak references. Consider
185             the following test script:
186              
187             use Test::More tests => 2;
188             use Test::Refcount;
189              
190             use MyBall;
191              
192             my $ball = MyBall->new();
193             is_oneref( $ball, 'One reference after construct' );
194              
195             $ball->bounce;
196              
197             # Any other code here that might be part of the test script
198              
199             is_oneref( $ball, 'One reference just before EOF' );
200              
201             The first assertion is just after the constructor, to check that the reference
202             returned by it is the only reference to that object. This fact is important if
203             we ever want C to behave properly. The second call is right at the
204             end of the file, just before the main scope closes. At this stage we expect
205             the reference count also to be one, so that the object is properly cleaned up.
206              
207             Suppose, when run, this produces the following output (presuming
208             L is available):
209              
210             1..2
211             ok 1 - One reference after construct
212             not ok 2 - One reference just before EOF
213             # Failed test 'One reference just before EOF'
214             # at ex.pl line 26.
215             # expected 1 references, found 2
216             # SV address is 0x55e14c310278
217             # Writing heap dump to ex-2.pmat
218             # Looks like you failed 1 test of 2.
219              
220             This has written a F file we can load using the C shell and
221             use the C command on the given address to find where it went:
222              
223             $ pmat ex-2.pmat
224             Perl memory dumpfile from perl 5.28.1 threaded
225             Heap contains 25233 objects
226             pmat> identify 0x55e14c310278
227             HASH(0)=MyBall at 0x55e14c310278 is:
228             ├─(via RV) the lexical $ball at depth 1 of CODE() at 0x55e14c3104a0=main_cv, which is:
229             │ └─the main code
230             └─(via RV) value {self} of HASH(2) at 0x55e14cacb860, which is (*A):
231             └─(via RV) value {cycle} of HASH(2) at 0x55e14cacb860, which is:
232             itself
233              
234             (This document isn't intended to be a full tutorial on L and the
235             C shell; for that see L).
236              
237             Alternatively, this produces the following output when using L
238             instead:
239              
240             1..2
241             ok 1 - One reference after construct
242             not ok 2 - One reference just before EOF
243             # Failed test 'One reference just before EOF'
244             # at demo.pl line 16.
245             # expected 1 references, found 2
246             # MyBall=ARRAY(0x817f880) is
247             # +- referenced by REF(0x82c1fd8), which is
248             # | in the member 'self' of HASH(0x82c1f68), which is
249             # | referenced by REF(0x81989d0), which is
250             # | in the member 'cycle' of HASH(0x82c1f68), which was seen before.
251             # +- referenced by REF(0x82811d0), which is
252             # in the lexical '$ball' in CODE(0x817fa00), which is
253             # the main body of the program.
254             # Looks like you failed 1 test of 2.
255              
256             From this output, we can see that the constructor was well-behaved, but that a
257             reference was leaked by the end of the script - the reference count was 2,
258             when we expected just 1. Reading the trace output, we can see that there were
259             2 references that could be found - one stored in the $ball lexical in the main
260             program, and one stored in a HASH. Since we expected to find the $ball lexical
261             variable, we know we are now looking for a leak in a hash somewhere in the
262             code. From reading the test script, we can guess this leak is likely to be in
263             the bounce() method. Furthermore, we know that the reference to the object
264             will be stored in a HASH in a member called C.
265              
266             By reading the code which implements the bounce() method, we can see this is
267             indeed the case:
268              
269             sub bounce
270             {
271             my $self = shift;
272             my $cycle = { self => $self };
273             $cycle->{cycle} = $cycle;
274             }
275              
276             From reading the tracing output, we find that the HASH this object is
277             referenced in also contains a reference to itself, in a member called
278             C. This comes from the last line in this function, a line that
279             purposely created a cycle, to demonstrate the point. While a real program
280             probably wouldn't do anything quite this obvious, the trace would still be
281             useful in finding the likely cause of the leak.
282              
283             If neither C nor C are available, then
284             these detailed traces will not be produced. The basic reference count testing
285             will still take place, but a smaller message will be produced:
286              
287             1..2
288             ok 1 - One reference after construct
289             not ok 2 - One reference just before EOF
290             # Failed test 'One reference just before EOF'
291             # at demo.pl line 16.
292             # expected 1 references, found 2
293             # Looks like you failed 1 test of 2.
294              
295             =head1 BUGS
296              
297             =over 4
298              
299             =item * Temporaries created on the stack
300              
301             Code which creates temporaries on the stack, to be released again when the
302             called function returns does not work correctly on perl 5.8 (and probably
303             before). Examples such as
304              
305             is_oneref( [] );
306              
307             may fail and claim a reference count of 2 instead.
308              
309             Passing a variable such as
310              
311             my $array = [];
312             is_oneref( $array );
313              
314             works fine. Because of the intention of this test module; that is, to assert
315             reference counts on some object stored in a variable during the lifetime of
316             the test script, this is unlikely to cause any problems.
317              
318             =back
319              
320             =head1 ACKNOWLEDGEMENTS
321              
322             Peter Rabbitson - for suggesting using core's C
323             instead of C to obtain refcounts
324              
325             =head1 AUTHOR
326              
327             Paul Evans
328              
329             =cut
330              
331             0x55AA;