%PDF- %PDF-
Mini Shell

Mini Shell

Direktori : /home/opti/optisoftcom/.cpanm/work/1544535425.21555/Path-Tiny-0.108/t/
Upload File :
Create Path :
Current File : /home/opti/optisoftcom/.cpanm/work/1544535425.21555/Path-Tiny-0.108/t/basic.t

use 5.008001;
use strict;
use warnings;
use Test::More 0.96;
use File::Spec;
use Path::Tiny;
use Cwd;

my $IS_WIN32 = $^O eq 'MSWin32';

use lib 't/lib';
use TestUtils qw/exception/;

my $file1 = path('foo.txt');
isa_ok( $file1, "Path::Tiny" );
ok $file1->isa('Path::Tiny');
is $file1, 'foo.txt';
ok $file1->is_relative;
is $file1->dirname,  '.';
is $file1->basename, 'foo.txt';

my $file2 = path( 'dir', 'bar.txt' );
is $file2, 'dir/bar.txt';
ok !$file2->is_absolute;
is $file2->dirname,  'dir/';
is $file2->basename, 'bar.txt';

my $dir = path('tmp');
is $dir, 'tmp';
ok !$dir->is_absolute;
is $dir->basename, 'tmp';

my $dir2 = path('/tmp');
is $dir2, '/tmp';
ok $dir2->is_absolute;

my $cat = path( $dir, 'foo' );
is $cat, 'tmp/foo';
$cat = $dir->child('foo');
is $cat, 'tmp/foo';
is $cat->dirname,  'tmp/';
is $cat->basename, 'foo';

$cat = path( $dir2, 'foo' );
is $cat, '/tmp/foo';
$cat = $dir2->child('foo');
is $cat,     '/tmp/foo';
isa_ok $cat, 'Path::Tiny';
is $cat->dirname, '/tmp/';

$cat = $dir2->child('foo');
is $cat,     '/tmp/foo';
isa_ok $cat, 'Path::Tiny';
is $cat->basename, 'foo';

my $sib = $cat->sibling('bar');
is $sib,     '/tmp/bar';
isa_ok $sib, 'Path::Tiny';

my $file = path('/foo//baz/./foo');
is $file, '/foo/baz/foo';
is $file->dirname, '/foo/baz/';
is $file->parent,  '/foo/baz';

{
    my $file = path("foo/bar/baz");
    is( $file->canonpath, File::Spec->canonpath("$file"), "canonpath" );
}

{
    my $dir = path('/foo/bar/baz');
    is $dir->parent, '/foo/bar';
    is $dir->parent->parent, '/foo';
    is $dir->parent->parent->parent, '/';
    is $dir->parent->parent->parent->parent, '/';

    $dir = path('foo/bar/baz');
    is $dir->parent, 'foo/bar';
    is $dir->parent->parent, 'foo';
    is $dir->parent->parent->parent, '.';
    is $dir->parent->parent->parent->parent, '..';
    is $dir->parent->parent->parent->parent->parent, '../..';
}

{
    my $dir = path("foo/");
    is $dir, 'foo';
    is $dir->parent, '.';
}

{
    # Special cases
    for my $bad ( [''], [undef], [], [ '', 'var', 'tmp' ], [ 'foo', '', 'bar' ] ) {
        like( exception { path(@$bad) }, qr/positive-length/, "exception" );
    }
    is( Path::Tiny->cwd,     path( Cwd::getcwd() ) );
    is( path('.')->absolute, path( Cwd::getcwd() ) );
}

{
    my $file = path('/tmp/foo/bar.txt');
    is $file->relative('/tmp'),      'foo/bar.txt';
    is $file->relative('/tmp/foo'),  'bar.txt';
    is $file->relative('/tmp/'),     'foo/bar.txt';
    is $file->relative('/tmp/foo/'), 'bar.txt';

    $file = path('one/two/three');
    is $file->relative('one'), 'two/three';

    $file = path('/one[0/two');
    is $file->relative( '/one[0' ), 'two', 'path with regex special char';
}

{
    my $file = Path::Tiny->new( File::Spec->rootdir );
    my $root = Path::Tiny->rootdir;
    is( $file,               $root,  "rootdir is like path('/')" );
    is( $file->child("lib"), "/lib", "child of rootdir is correct" );
}

# constructor
{
    is( path(qw/foo bar baz/), Path::Tiny->new(qw/foo bar baz/), "path() vs new" );
    is( path(qw/foo bar baz/), path("foo/bar/baz"), "path(a,b,c) vs path('a/b/c')" );
}

# tilde processing
{
    my ($homedir) = glob('~');
    $homedir =~ tr[\\][/] if $IS_WIN32;
    my $username = path($homedir)->basename;
    my ($root_homedir) = glob('~root');
    my ($missing_homedir) = glob('~idontthinkso');

    my @tests = (
      # [arg for path(), expected string (undef if eq arg for path()), test string]
        ['~',                     $homedir,                 'Test my homedir' ],
        ['~/',                    $homedir,                 'Test my homedir with trailing "/"' ],
        ['~/foo/bar',             $homedir.'/foo/bar',      'Test my homedir with longer path' ],
        ['~/foo/bar/',            $homedir.'/foo/bar',      'Test my homedir, longer path and trailing "/"' ],
        ['~root',                 $root_homedir,            'Test root homedir' ],
        ['~root/',                $root_homedir,            'Test root homedir with trailing /' ],
        ['~root/foo/bar',         $root_homedir.'/foo/bar', 'Test root homedir with longer path' ],
        ['~root/foo/bar/',        $root_homedir.'/foo/bar', 'Test root homedir, longer path and trailing "/"'],
        ['~idontthinkso',         undef,                    'Test homedir of nonexistant user' ],
        ['~idontthinkso',         $missing_homedir,         'Test homedir of nonexistant user (via glob)' ],
        ['~blah blah',            undef,                    'Test space' ],
        ['~this is fun',          undef,                    'Test multiple spaces' ],
        ['~yikes \' apostrophe!', undef,                    'Test spaces and embedded apostrophe' ],
        ['~hum " quote',          undef,                    'Test spaces and embedded quote' ],
        ['~hello ~there',         undef,                    'Test space-separated tildes' ],
        ["~fun\ttimes",           undef,                    'Test tab' ],
        ["~new\nline",            undef,                    'Test newline' ],
        ['~'.$username.' file',   undef,                    'Test \'~$username file\'' ],
    );

    for my $test (@tests) {
        is(path($test->[0]), defined $test->[1] ? $test->[1] : $test->[0], $test->[2]);
    }
}

# freeze/thaw
{
    my $path = path("/foo/bar/baz");
    is( Path::Tiny->THAW( "fake", $path->FREEZE("fake") ),
        $path, "FREEZE-THAW roundtrip" );
}

# assertions
{
    my $err = exception {
        path("aljfakdlfadks")->assert( sub { $_->exists } )
    };
    like( $err, qr/failed assertion/, "assert exists" );
    my $path;
    $err = exception {
        $path = path("t")->assert( sub { -d && -r _ } )
    };
    is( $err, '', "no exception if assertion succeeds" );
    isa_ok( $path, "Path::Tiny", "assertion return value" );

    $err = exception {
        path(".")->visit(
            sub { $_[1]->{$_} = { path => $_ } },
            { recurse => 1 },
        );
    };
    is $err, "", 'no exception';
}

done_testing();

Zerion Mini Shell 1.0