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

use warnings;
use strict;

use Test::More tests => 18;

use lib 't';
use Util;

prep_environment();

subtest 'No starting directory specified' => sub {
    my $regex = 'non';

    my @files = qw( t/foo/non-existent );
    my @args = ( '-g', $regex );
    my ($stdout, $stderr) = run_ack_with_stderr( @args, @files );

    is_empty_array( $stdout, 'No STDOUT for non-existent file' );
    is( scalar @{$stderr}, 1, 'One line of STDERR for non-existent file' );
    like( $stderr->[0], qr/non-existent: No such file or directory/,
        'Correct warning message for non-existent file' );
};

subtest 'regex comes before -g on the command line' => sub {
    my $regex = 'non';

    my @files = qw( t/foo/non-existent );
    my @args = ( $regex, '-g' );
    my ($stdout, $stderr) = run_ack_with_stderr( @args, @files );

    is_empty_array( $stdout, 'No STDOUT for non-existent file' );
    is( scalar @{$stderr}, 1, 'One line of STDERR for non-existent file' );
    like( $stderr->[0], qr/non-existent: No such file or directory/,
        'Correct warning message for non-existent file' );
};

subtest 'No metacharacters' => sub {
    my @expected = qw(
        t/swamp/Makefile
        t/swamp/Makefile.PL
        t/swamp/notaMakefile
    );
    my $regex = 'Makefile';

    my @args  = ( '-g', $regex );
    my @files = qw( t/ );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex" );
};


subtest 'With metacharacters' => sub {
    my @expected = qw(
        t/swamp/html.htm
        t/swamp/html.html
    );
    my $regex = 'swam.......htm';

    my @args  = ( '-g', $regex );
    my @files = qw( t/ );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex" );
};

subtest 'Front anchor' => sub {
    my @expected = qw(
        t/file-permission.t
        t/filetypes.t
        t/filter.t
    );
    my $regex = '^t.fil';

    my @args  = ( '-g', $regex );
    my @files = qw( t );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex" );
};

subtest 'Back anchor' => sub {
    my @expected = qw(
        t/runtests.pl
        t/swamp/options-crlf.pl
        t/swamp/options.pl
        t/swamp/perl.pl
    );
    my $regex = 'pl$';

    my @args  = ( '-g', $regex );
    my @files = qw( t );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex" );
};

subtest 'Case-insensitive via -i' => sub {
    my @expected = qw(
        t/swamp/pipe-stress-freaks.F
    );
    my $regex = 'PIPE';

    my @args  = ( '-i', '-g', $regex );
    my @files = qw( t/swamp );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for -i -g $regex " );
};

subtest 'Case-insensitive via (?i:)' => sub {
    my @expected = qw(
        t/swamp/pipe-stress-freaks.F
    );
    my $regex = '(?i:PIPE)';

    my @files = qw( t/swamp );
    my @args  = ( '-g', $regex );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex" );
};

subtest 'File on command line is always searched' => sub {
    my @expected = ( 't/swamp/#emacs-workfile.pl#' );
    my $regex = 'emacs';

    my @args = ( '-g', $regex );
    my @files = ( 't/swamp/#emacs-workfile.pl#' );

    ack_sets_match( [ @args, @files ], \@expected, 'File on command line is always searched' );
};

subtest 'File on command line is always searched, even with wrong filetype' => sub {
    my @expected = qw(
        t/swamp/parrot.pir
    );
    my $regex = 'parrot';

    my @files = qw( t/swamp/parrot.pir );
    my @args  = ( '--html', '-g', $regex );

    ack_sets_match( [ @args, @files ], \@expected, 'File on command line is always searched, even with wrong type.' );
};

subtest '-Q works on -g' => sub {
    my @expected = qw(
    );
    my $regex = 'ack-g.t$';

    my @files = qw( t );
    my @args  = ( '-Q', '-g', $regex );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex with quotemeta." );

    @expected = (
        't/text/4th-of-july.txt',
        't/text/freedom-of-choice.txt',
        't/text/science-of-myth.txt',
    );
    $regex = 'of';

    @files = qw( t/text );
    @args  = ( '-Q', '-g', $regex, '--sort-files' );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex with quotemeta." );
};

subtest '-w works on -g' => sub {
    my @expected = qw();
    my $regex = 'free';

    my @args  = ( '-w', '-g', $regex, '--sort-files' ); # The -w means "free" won't match "freedom"
    my @files = qw( t/text/ );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex with '-w'." );

    @expected = (
        't/text/4th-of-july.txt',
        't/text/freedom-of-choice.txt',
        't/text/science-of-myth.txt',
    );
    $regex = 'of';

    @files = qw( t/text );
    @args  = ( '-w', '-g', $regex, '--sort-files' );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for $regex with '-w'." );
};

subtest '-v works on -g' => sub {
    my @expected = qw(
        t/text/boy-named-sue.txt
        t/text/me-and-bobbie-mcgee.txt
        t/text/number.txt
        t/text/numbered-text.txt
        t/text/shut-up-be-happy.txt
    );
    my $file_regex = 'of';

    my @args  = ( '-v', '-g', $file_regex, '--sort-files' );
    my @files = qw( t/text/ );

    ack_sets_match( [ @args, @files ], \@expected, "Looking for file names that do not match $file_regex" );
};

subtest '--smart-case works on -g' => sub {
    my @expected = qw(
        t/swamp/pipe-stress-freaks.F
        t/swamp/crystallography-weenies.f
    );

    my @files = qw( t/swamp );
    my @args  = ( '--smart-case', '-g', 'f$' );

    ack_sets_match( [ @args, @files ], \@expected, 'Looking for f$' );

    @expected = qw(
        t/swamp/pipe-stress-freaks.F
    );
    @args = ( '--smart-case', '-g', 'F$' );

    ack_sets_match( [ @args, @files ], \@expected, 'Looking for f$' );
};

subtest 'test exit codes' => sub {
    my $file_regex = 'foo';
    my @files      = ( 't/text/' );

    run_ack( '-g', $file_regex, @files );
    is( get_rc(), 1, '-g with no matches must exit with 1' );

    $file_regex = 'boy';

    run_ack( '-g', $file_regex, @files );
    is( get_rc(), 0, '-g with matches must exit with 0' );
};

subtest 'test -g on a path' => sub {
    my $file_regex = 'text';
    my @expected   = (
        't/context.t',
        't/text/4th-of-july.txt',
        't/text/boy-named-sue.txt',
        't/text/freedom-of-choice.txt',
        't/text/me-and-bobbie-mcgee.txt',
        't/text/number.txt',
        't/text/numbered-text.txt',
        't/text/science-of-myth.txt',
        't/text/shut-up-be-happy.txt',
    );
    my @args = ( '--sort-files', '-g', $file_regex );

    ack_sets_match( [ @args ], \@expected, 'Make sure -g matches the whole path' );
};

subtest 'test -g with --color' => sub {
    my $file_regex = 'text';
    my $expected_original = <<'END_COLOR';
t/con(text).t
t/(text)/4th-of-july.txt
t/(text)/boy-named-sue.txt
t/(text)/freedom-of-choice.txt
t/(text)/me-and-bobbie-mcgee.txt
t/(text)/number.txt
t/(text)/numbered-(text).txt
t/(text)/science-of-myth.txt
t/(text)/shut-up-be-happy.txt
END_COLOR

    $expected_original = windows_slashify( $expected_original ) if is_windows;

    my @expected   = colorize( $expected_original );

    my @args = ( '--sort-files', '-g', $file_regex );

    my @results = run_ack(@args, '--color');

    is_deeply( \@results, \@expected, 'Colorizing -g output with --color should work');
};

subtest q{test -g without --color; make sure colors don't show} => sub {
    if ( !has_io_pty() ) {
        plan skip_all => 'IO::Pty is required for this test';
        return;
    }

    my $file_regex = 'text';
    my $expected   = <<'END_OUTPUT';
t/context.t
t/text/4th-of-july.txt
t/text/boy-named-sue.txt
t/text/freedom-of-choice.txt
t/text/me-and-bobbie-mcgee.txt
t/text/number.txt
t/text/numbered-text.txt
t/text/science-of-myth.txt
t/text/shut-up-be-happy.txt
END_OUTPUT

    my @args = ( '--sort-files', '-g', $file_regex );

    my $results = run_ack_interactive(@args);

    is( $results, $expected, 'Colorizing -g output without --color should have no color' );
};

done_testing();