1#!perl 2 3use 5.010; 4use strict; 5use warnings; 6use lib 'inc'; 7use lib 'lib'; 8 9use Test::More; 10 11BEGIN { 12 if ( eval { require Task::Weaken } ) { 13 Test::More::plan tests => 3; 14 } 15 else { 16 Test::More::plan skip_all => 'Scalar::Util::weaken() not implemented'; 17 } 18 Test::More::use_ok('Marpa'); 19 Test::More::use_ok('Test::Weaken'); 20} ## end BEGIN 21 22my $test = sub { 23 my $g = Marpa::Grammar->new( 24 { start => 'S', 25 rules => [ 26 [ 'S', [qw/A A A A/] ], 27 [ 'A', [qw/a/] ], 28 [ 'A', [qw/E/] ], 29 ['E'], 30 ], 31 terminals => ['a'], 32 } 33 ); 34 $g->precompute(); 35 my $recce = Marpa::Recognizer->new( { grammar => $g } ); 36 $recce->tokens( [ ( [ 'a', 'a', 1 ] ) x 4 ] ); 37 $recce->value(); 38 [ $g, $recce ]; 39}; 40 41my $tester = Test::Weaken->new($test); 42my $unfreed_count = $tester->test(); 43my $unfreed_proberefs = $tester->unfreed_proberefs(); 44my $total = $tester->probe_count(); 45my $freed_count = $total - $unfreed_count; 46 47# The evaluator (for And_Node::PERL_CLOSURE) assigns a \undef, and this creates 48# an undef "global". No harm done if there's only one. 49 50my $ignored_count = 0; 51DELETE_UNDEF_CONSTANT: for my $ix ( 0 .. $#{$unfreed_proberefs} ) { 52 if ( ref $unfreed_proberefs->[$ix] eq 'SCALAR' 53 and not defined ${ $unfreed_proberefs->[$ix] } ) 54 { 55 delete $unfreed_proberefs->[$ix]; 56 $ignored_count++; 57 last DELETE_UNDEF_CONSTANT; 58 } ## end if ( ref $unfreed_proberefs->[$ix] eq 'SCALAR' and not...) 59} ## end for my $ix ( 0 .. $#{$unfreed_proberefs} ) 60$unfreed_count = @{$unfreed_proberefs}; 61 62# "Freed=$freed_count, ignored=$ignored_count, unfreed=$unfreed_count, total=$total" 63 64Test::More::cmp_ok( $unfreed_count, q{==}, 0, 'All refs freed' ) 65 or Test::More::diag("Unfreed refs: $unfreed_count"); 66 67# Local Variables: 68# mode: cperl 69# cperl-indent-level: 4 70# fill-column: 100 71# End: 72# vim: expandtab shiftwidth=4: 73