sub
has_symlinks {
return
$Config
{d_symlink}
unless
$^O eq
'msys'
|| $^O eq
'MSWin32'
;
if
($^O eq
'msys'
) {
return
unless
$Config
{d_symlink};
return
$ENV
{MSYS} =~ /winsymlinks:nativestrict/;
}
elsif
($^O eq
'MSWin32'
) {
my
$error
;
my
$can_symlink
;
{
local
$@;
$error
= $@ ||
'Error'
unless
eval
{
my
$wd
= File::Temp->newdir();
my
$foo
= File::Spec->catfile(
$wd
,
'foo'
);
my
$bar
= File::Spec->catfile(
$wd
,
'bar'
);
open
my
$fh
,
'>'
,
$foo
;
$can_symlink
=
symlink
$foo
,
$bar
;
1;
};
}
return
1
if
$can_symlink
&& !
$error
;
return
;
}
}
{
local
@INC
=
@INC
;
lib::relative->
import
(
'testlib'
);
ok((
grep
{ m!\btestlib\b! and File::Spec->file_name_is_absolute(
$_
) }
@INC
),
'absolute path to testlib in @INC'
);
ok((
eval
{
require
MyTestModule; 1 }),
'loaded MyTestModule from testlib'
)
or diag $@;
is MyTestModule::foo(),
'bar'
,
'correct function results'
;
}
{
local
@INC
=
@INC
;
my
$path
= File::Spec->catdir(File::Basename::dirname(Cwd::abs_path __FILE__),
'testlib'
);
lib::relative->
import
(
$path
);
ok((
grep
{
$_
eq
$path
}
@INC
),
'absolute path to testlib in @INC'
);
ok((
eval
{
require
MyTestModule2; 1 }),
'loaded MyTestModule2 from testlib'
)
or diag $@;
is MyTestModule2::foo(),
'baz'
,
'correct function results'
;
}
SKIP: {
skip
'symlinks not supported in this build'
, 4
unless
has_symlinks();
local
@INC
=
@INC
;
my
$dir
= File::Temp->newdir;
skip 4,
'tempdir in @INC'
if
grep
{ m!^\Q
$dir
\E! }
@INC
;
my
$path
= File::Spec->catfile(File::Basename::dirname(Cwd::abs_path __FILE__),
'testlib'
,
'load_relative.pl'
);
my
$link
= File::Spec->catfile(
$dir
,
'load_relative.pl'
);
my
$rc
;
eval
{
$rc
=
symlink
$path
,
$link
; 1 } or skip
'symlinks not supported'
, 4;
die
"symlink failed: $!"
unless
$rc
;
do
$link
or
die
"failed to run $path: $!"
;
ok((
grep
{ m!\btestlib\b! and File::Spec->file_name_is_absolute(
$_
) }
@INC
),
'absolute path to testlib in @INC'
);
ok(!(
grep
{ m!^\Q
$dir
\E! }
@INC
),
'tempdir not in @INC'
);
ok((
eval
{
require
MyTestModule3; 1 }),
'loaded MyTestModule3 from testlib'
)
or diag $@;
is MyTestModule3::foo(),
'buzz'
,
'correct function results'
;
}
done_testing;