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    my $evaler = Marpa::Evaluator->new( { recce => $recce } );
38    Marpa::exception('No parse found') if not $evaler;
39    $evaler->value();
40    [ $g, $recce, $evaler ];
41};
42
43my $tester            = Test::Weaken->new($test);
44my $unfreed_count     = $tester->test();
45my $unfreed_proberefs = $tester->unfreed_proberefs();
46my $total             = $tester->probe_count();
47my $freed_count       = $total - $unfreed_count;
48
49# The evaluator (for And_Node::PERL_CLOSURE) assigns a \undef, and this creates
50# an undef "global".  No harm done if there's only one.
51
52my $ignored_count = 0;
53DELETE_UNDEF_CONSTANT: for my $ix ( 0 .. $#{$unfreed_proberefs} ) {
54    if ( ref $unfreed_proberefs->[$ix] eq 'SCALAR'
55        and not defined ${ $unfreed_proberefs->[$ix] } )
56    {
57        delete $unfreed_proberefs->[$ix];
58        $ignored_count++;
59        last DELETE_UNDEF_CONSTANT;
60    } ## end if ( ref $unfreed_proberefs->[$ix] eq 'SCALAR' and not...)
61} ## end for my $ix ( 0 .. $#{$unfreed_proberefs} )
62$unfreed_count = @{$unfreed_proberefs};
63
64# "Freed=$freed_count, ignored=$ignored_count, unfreed=$unfreed_count, total=$total"
65
66Test::More::cmp_ok( $unfreed_count, q{==}, 0, 'All refs freed' )
67    or Test::More::diag("Unfreed refs: $unfreed_count");
68
69# Local Variables:
70#   mode: cperl
71#   cperl-indent-level: 4
72#   fill-column: 100
73# End:
74# vim: expandtab shiftwidth=4:
75