The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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' );
	}
}