1#!/usr/bin/perl -w 2 3use strict; 4use Test::More; 5 6eval 'use Test::Weaken qw(leaks)'; 7plan skip_all => 'Test::Weaken required to test for memory leaks' if $@; 8 9plan tests => 6; 10 11use FSA::Rules; 12 13my $leaks = leaks(sub { 14 ok my $fsa = +FSA::Rules->new( 15 foo => {}, 16 ), "Construct with a single state"; 17 return $fsa; 18}); 19 20ok !$leaks, 'There should be no leaks' or 21 diag sprintf '%d of %d original references were not freed', 22 $leaks->unfreed_count, $leaks->probe_count; 23 24my %states; 25$leaks = leaks(sub { 26 ok my $fsa = +FSA::Rules->new( 27 foo => { 28 on_enter => sub { shift->machine->{foo_enter}++ }, 29 do => sub { shift->machine->{foo}++ }, 30 on_exit => sub { shift->machine->{foo_exit}++ }, 31 rules => [ 32 bar => sub { shift->machine->{foo} }, 33 ], 34 }, 35 bar => { 36 on_enter => sub { shift->machine->{bar_enter}++ }, 37 do => sub { $_[0]->machine->{bar} = $_[0]->machine->{bar_enter} }, 38 rules => [ 39 foo => sub { shift->machine->{bar} }, 40 ], 41 }, 42 ), "Construct with mutually-referenced state rule"; 43 %states = map { $_->name => "$_" } $fsa->states; 44 return $fsa; 45}); 46 47ok !$leaks, 'There should be no leaks with circular rules' or 48 diag sprintf '%d of %d original references were not freed', 49 $leaks->unfreed_count, $leaks->probe_count; 50 51# FSA::State sneakily uses the memory address of the object to find its 52# attributes in the file-coped %states lexical. So we take advantage of that 53# by trapping the addresses as strings in the call to leaks() above, and then 54# passing them to name() as if they were objects. If there is no leak, the 55# objects should not exist. If there is a leak, they will still exist and 56# return their names. 57while (my ($state, $address) = each %states) { 58 ok !FSA::State::name($address), qq{State "$state" should no longer exist}; 59} 60