view release on metacpan or  search on metacpan

ext/File-Glob/t/basic.t  view on Meta::CPAN

    @INC = '../lib';
    require Config; Config->import;
    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
        print "1..0\n";
        exit 0;
    }
}
use strict;
use Test::More tests => 56;
BEGIN {use_ok('File::Glob', ':glob')};
use Cwd ();

my $vms_unix_rpt = 0;
my $vms_efs = 0;
my $vms_mode = 0;
if ($^O eq 'VMS') {
    if (eval 'require VMS::Feature') {
        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
        $vms_efs = VMS::Feature::current("efs_charset");
    } else {
        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
        my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
        $vms_efs = $efs_charset =~ /^[ET1]/i;
    }
    $vms_mode = 1 unless ($vms_unix_rpt);
}


# look for the contents of the current directory
# try it in a directory that doesn't get modified during testing,
# so parallel testing won't give us race conditions. t/base/ seems
# fairly static

chdir 'base' or die "chdir base: $!";
$ENV{PATH} = "/bin";
delete @ENV{qw(BASH_ENV CDPATH ENV IFS)};
my @correct = ();
if (opendir(D, ".")) {
   @correct = grep { !/^\./ } sort readdir(D);
   closedir D;
}

is(
    File::Glob->can('glob'),
    undef,
    'Did not find glob() function in File::Glob',
);

chdir '..' or die "chdir .. $!";

# look up the user's home directory
# should return a list with one item, and not set ERROR
my @a;

SKIP: {
    my ($name, $home);
    skip $^O, 2 if $^O eq 'MSWin32' || $^O eq 'VMS'
        || $^O eq 'os2';
    skip "Can't find user for $>: $@", 2 unless eval {
        ($name, $home) = (getpwuid($>))[0,7];
        1;
    };
    skip "$> has no home directory", 2
        unless defined $home && defined $name && -d $home;

    @a = bsd_glob("~$name", GLOB_TILDE);

    if (GLOB_ERROR) {
        fail(GLOB_ERROR);
    } else {
        is_deeply (\@a, [$home],
            "GLOB_TILDE expands patterns that start with '~' to user name home directories"
        );
    }

    my @b = bsd_glob("~$name", GLOB_TILDE | GLOB_MARK);

    if (GLOB_ERROR) {
        fail(GLOB_ERROR);
    } else {
        is_deeply (\@b, ["$home/"],
            "GLOB_MARK matches directories with path separator attached"
        );
    }
}
# check plain tilde expansion
{
    my $tilde_check = sub {
        my @a = bsd_glob('~');

        if (GLOB_ERROR) {
            fail(GLOB_ERROR);
        } else {
            is_deeply (\@a, [$_[0]], join ' - ', 'tilde expansion', @_ > 1 ? $_[1] : ());
        }
    };
    my $passwd_home = eval { (getpwuid($>))[7] };

    TODO: {
        local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS';
        local $ENV{HOME};
        delete $ENV{HOME};
        local $ENV{USERPROFILE};
        delete $ENV{USERPROFILE};
        $tilde_check->(defined $passwd_home ? $passwd_home : q{~}, 'no environment');
    }

    SKIP: {
        skip 'MSWin32 only', 1 if $^O ne 'MSWin32';
        local $ENV{HOME};
        delete $ENV{HOME};
        local $ENV{USERPROFILE};
        $ENV{USERPROFILE} = 'sweet win32 home';
        $tilde_check->(defined $passwd_home ? $passwd_home : $ENV{USERPROFILE}, 'USERPROFILE');
    }

    TODO: {
        local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS';
        my $home = exists $ENV{HOME} ? $ENV{HOME}
        : eval { getpwuid($>); 1 } ? (getpwuid($>))[7]
        : $^O eq 'MSWin32' && exists $ENV{USERPROFILE} ? $ENV{USERPROFILE}
        : q{~};
        $tilde_check->($home);
    }
}

# check backslashing
# should return a list with one item, and not set ERROR
@a = bsd_glob('TEST', GLOB_QUOTE);
if (GLOB_ERROR) {
    fail(GLOB_ERROR);
} else {
    is_deeply(\@a, ['TEST'], "GLOB_QUOTE works as expected");
}

# check nonexistent checks
# should return an empty list
# XXX since errfunc is NULL on win32, this test is not valid there
SKIP: {
    skip $^O, 5 if $^O eq 'MSWin32';
    my @a = bsd_glob("asdfasdf", 0);
    is_deeply(\@a, [], "bsd_glob() works as expected for unmatched pattern and 0 flag");

    my $pattern = "asdfasdf";
    @a = bsd_glob($pattern, GLOB_NOCHECK);
    is(scalar @a, 1,
        "unmatched pattern with GLOB_NOCHECK returned single-item list");
    cmp_ok($a[0], 'eq', $pattern,
        "bsd_glob() works as expected for unmatched pattern and GLOB_NOCHECK flag");

    my @b = bsd_glob($pattern, GLOB_NOCHECK | GLOB_QUOTE);
    is(scalar @b, 1,
        "unmatched pattern with GLOB_NOCHECK and GLOB_QUOTE returned single-item list");
    cmp_ok($b[0], 'eq', $pattern,
        "bsd_glob() works as expected for unmatched pattern and GLOB_NOCHECK and GLOB_QUOTE flags");
}

# check bad protections
# should return an empty list, and set ERROR
SKIP: {
    skip $^O, 2 if $^O eq 'MSWin32'
        or $^O eq 'os2' or $^O eq 'VMS' or $^O eq 'cygwin';
    skip "AFS", 2 if Cwd::cwd() =~ m#^$Config{'afsroot'}#s;
    skip "running as root", 2 if not $>;

    my $dir = "pteerslo";
    mkdir $dir, 0;
    @a = bsd_glob("$dir/*", GLOB_ERR);
    rmdir $dir;
    local $TODO = 'hit VOS bug posix-956' if $^O eq 'vos';

    isnt(GLOB_ERROR, 0, "GLOB_ERROR is not 0");
    is_deeply(\@a, [], "Got empty list as expected");
}

# check for csh style globbing
@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
is_deeply(\@a, ['a', 'b'], "Check for csh-style globbing");

@a = bsd_glob(