#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 16;
use_ok( 'B::XPath' );
use YAML;
my $tests =
[
{
expression => q|//gvsv[@NAME='foo']|,
matches =>
[
{
NAME => 'foo',
find_file => $0,
find_line => 'foo',
},
{
NAME => 'foo',
find_file => $0,
find_line => 'fooi',
},
],
},
{
expression => q|//gvsv|,
matches =>
[
{
NAME => 'foo',
find_file => $0,
find_line => 'foo',
},
# this occurs after the foo interpolation in the code
# but not as deeply in the optree -- so it comes first here
{
NAME => 'bar',
find_file => $0,
find_line => 'bar',
},
{
NAME => 'foo',
find_file => $0,
find_line => 'fooi',
},
],
}
];
use vars qw( $foo $bar );
my %lines =
(
foo => __LINE__ + 8,
fooi => __LINE__ + 8,
bar => __LINE__ + 8,
);
sub some_sub
{
my $x = shift;
$foo = $x;
print "\$x is $x\n\$foo is $foo\n";
$bar = $x * 2;
}
my $node = B::XPath->fetch_root( \&some_sub );
for my $test (@$tests)
{
for my $match ( $node->match( $test->{expression} ) )
{
warn "Out of matches!\n" unless @{ $test->{matches} };
my $match_test = shift @{ $test->{matches} };
is( $match->NAME(), $match_test->{NAME},
"GV found with right name $match_test->{NAME}" );
is( $match->get_file(), $match_test->{find_file},
'... in correct file' );
is( $match->get_line(), $lines{ $match_test->{find_line} },
'... and on proper line' );
}
}