use
5.008001;
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;