1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
use 5.008001;
use strict;
use warnings;
use Test::More 0.96;
use lib 't/lib';
use TestUtils qw/exception has_symlinks/;
use Path::Tiny;
use Cwd 'abs_path';
plan skip_all => "No symlink support" unless has_symlinks();
subtest "relative symlinks with updir" => sub {
my $temp = Path::Tiny->tempdir;
my $td = $temp->realpath;
$td->child(qw/tmp tmp2/)->mkdir;
my $foo = $td->child(qw/tmp foo/)->touch;
my $bar = $td->child(qw/tmp tmp2 bar/);
symlink "../foo", $bar or die "Failed to symlink: $!\n";
ok -f $foo, "it's a file";
ok -l $bar, "it's a link";
is readlink $bar, "../foo", "the link seems right";
is abs_path($bar), $foo, "abs_path gets's it right";
is $bar->realpath, $foo, "realpath get's it right";
};
subtest "symlink loop detection" => sub {
my $temp = Path::Tiny->tempdir;
my $td = $temp->realpath;
$td->child("A")->touch;
for my $pair ( [qw/A B/], [qw/B C/], [qw/C A/] ) {
my $target = $td->child( $pair->[1] );
$target->remove if -e $target;
symlink $pair->[0], $td->child( $pair->[1] ) or die "Failed to symlink @$pair: $!\n";
}
diag for $td->children;
like(
exception { $td->child("A")->realpath },
qr/symlink loop detected/,
"symlink loop detected"
);
};
done_testing;
#
# This file is part of Path-Tiny
#
# This software is Copyright (c) 2014 by David Golden.
#
# This is free software, licensed under:
#
# The Apache License, Version 2.0, January 2004
#
# vim: set ts=4 sts=4 sw=4 et tw=75:
|
