investigate reference scope issues

[wchristian]

See: https://rt.cpan.org/Ticket/Display.html?id=73344 https://rt.cpan.org/Ticket/Display.html?id=67842

[wchristian]

Possibly related: https://rt.cpan.org/Public/Bug/Display.html?id=91274

[kentfredric]

I appear to have stumbled into an incarnation of this issue. From what I can see, the objects returned by find_first are for some annihilated when the parent document goes out of scope. Poking around with isweak and unweaken didn't seem to circumvent the issue so I'd guess there's some code in PPI top level that explicitly nukes the whole tree when the document vanishes.

Ugh.... yes

https://metacpan.org/source/PPI::Node#L674

sub DESTROY {
        local $_;
        if ( $_[0]->{children} ) {
                my @queue = $_[0];
                while ( defined($_ = shift @queue) ) {
                        unshift @queue, @{delete $_->{children}} if $_->{children};

                        # Remove all internal/private weird crosslinking so that
                        # the cascading DESTROY calls will get called properly.
                        %$_ = ();
                }
        }

        # Remove us from our parent node as normal
        delete $_PARENT{refaddr $_[0]};
}

And that code has been there since before git history: https://github.com/adamkennedy/PPI/commit/7c92e6c2f4b0aec9775f6b08bcfd4fd1fa598c0a

Test that exhibits the probem:

use strict;
use warnings;

use PPI::Util qw( _Document );

my $sample = <<'EOF';
package Foo::Bar;

1;
EOF

{
  # Pass 1
  my $result = _Document( \$sample );
  isa_ok( $result, 'PPI::Document' );

  my $pkg_node = $result->find_first('PPI::Statement::Package');
  isa_ok( $pkg_node, 'PPI::Statement::Package' );
  note explain $pkg_node;

  is( $pkg_node->namespace, 'Foo::Bar', 'Extract Namespace match' );
}

{
  # Pass 2
  isa_ok( _Document( \$sample ), 'PPI::Document' );

  my $pkg_node =  _Document( \$sample )->find_first('PPI::Statement::Package');
  isa_ok( $pkg_node, 'PPI::Statement::Package' );

  note explain $pkg_node;

  is( $pkg_node->namespace, 'Foo::Bar', 'Extract Namespace match' );
}

done_testing;

[kentfredric]

And here's an amusing case which accidentally nukes the original DOM ...

use strict;
use warnings;

use Test::More;
use Scalar::Util qw( unweaken );

use PPI::Util qw( _Document );

my $sample = <<'EOF';
package Foo::Bar;

1;
EOF

my $result = _Document( \$sample );
isa_ok( $result, 'PPI::Document' );

my $pkg_node = $result->find_first('PPI::Statement::Package');
is( $pkg_node->namespace, 'Foo::Bar', 'Extract Namespace match' );

{
  my $funbags = bless { children => [$pkg_node] }, 'PPI::Node';
  is( $pkg_node->namespace, 'Foo::Bar', 'Extract Namespace match' );
}

is( $pkg_node->namespace, 'Foo::Bar', 'Extract Namespace match' );

done_testing;

[karenetheridge]

wow, nice find; that's some crazy code there :)