The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use strict;
use warnings;

use File::Spec::Functions qw( catfile );
use Test::Tester;
use Test::More;

use Test::Vars;

my %errors = (
    Warned1 => [ [ '$an_unused_var', 'foo', 6 ] ],
    Warned2 => [ [ '@an_unused_var', 'foo', 6 ] ],
    Warned3 => [ [ '%an_unused_var', 'foo', 6 ] ],
    Warned4 => [ [ '$an_unused_var', 'foo', 6 ] ],

    # For some version of Perl, we get the warning on line 6 twice, for others
    # we get 6 and 7.
    Warned5 => [
        [ '$unused_var', 'foo', 6 ],
        [ '$unused_var', 'foo', [ 6, 7 ] ],
    ],
    Warned6 => [ [ '$unused_param', 'foo', 6 ] ],

    # The diag output from Warned7 is not in a predictable order, so we have
    # to ignore it.
    Warned7 => [
        [ '$unused_var', 'foo', 6 ],
        [ '$unused_var', 'bar', 13 ],
    ],
);

foreach my $package ( sort keys %errors ) {
    my $errors = $errors{$package};
    my $path = catfile( qw( t lib ), "$package.pm" );
    my $unix_path = "t/lib/$package.pm";

    my ( $premature, @results ) = run_tests( sub { vars_ok($path) } );
    ok( !$premature, "var_ok($path) had no premature output" );
    is( scalar @results, 1, "got one result from vars_ok($path)" );
    is(
        $results[0]{fail_diag}, "\tFailed test ($0 at line 39)\n",
        'failure message comes from inside this test file'
    );

    if ( @{$errors} == 1 ) {
        like(
            $results[0]{diag},
            _error( @{ $errors->[0] }, $package, $unix_path ),
            "expected diag() from vars_ok($path)"
        );
    }
    else {
        my @errors = map { _error( @{$_}, $package, $unix_path ) } @{$errors};
        like(
            $results[0]{diag},
            qr/$errors[0]$errors[1]|$errors[1]$errors[0]/,
            "expected diag() from vars_ok($path)"
        );
    }
}

sub _error {
    my ( $var, $sub, $line, $package, $path ) = @_;

    $line
        = ref $line
        ? qr/(?:$line->[0]|$line->[1])/
        : qr/$line/;

    return qr/\Q$var is used once in &${package}::$sub at $path line \E$line\n/;
}

done_testing;