Cross Reference: crossplatform.t
xref
: /
osnet-11
/
usr
/
src
/
cmd
/
perl
/
5.8.4
/
distrib
/
lib
/
File
/
Spec
/
t
/
crossplatform.t
Home
History
Annotate
Line#
Navigate
Download
Search
only in
./
1
N/A
#!/
usr
/
bin
/
perl
-w
1
N/A
1
N/A
use
strict
;
1
N/A
use
Test
::
More
;
1
N/A
use
File
::
Spec
;
1
N/A
local
$|=
1
;
1
N/A
1
N/A
my
@
platforms
=
qw
(
Cygwin
Epoc
Mac
OS2
Unix
VMS
Win32
)
;
1
N/A
my
$tests_per_platform
=
7
;
1
N/A
1
N/A
plan
tests
=>
1
+ @
platforms
*
$tests_per_platform
;
1
N/A
1
N/A
my
%
volumes
=
(
1
N/A
Mac
=>
'Macintosh HD'
,
1
N/A
OS2
=>
'A:'
,
1
N/A
Win32
=>
'A:'
,
1
N/A
VMS
=>
'v'
,
1
N/A
)
;
1
N/A
my
%
other_vols
=
(
1
N/A
Mac
=>
'Mounted Volume'
,
1
N/A
OS2
=>
'B:'
,
1
N/A
Win32
=>
'B:'
,
1
N/A
VMS
=>
'w'
,
1
N/A
)
;
1
N/A
1
N/A
ok
1
,
"Loaded"
;
1
N/A
1
N/A
foreach
my
$platform
(@
platforms
)
{
1
N/A
my
$module
=
"File::Spec::
$platform
"
;
1
N/A
1
N/A
SKIP
:
1
N/A
{
1
N/A
eval
"require
$module
; 1"
;
1
N/A
1
N/A
skip
"Can't load
$module
"
,
$tests_per_platform
1
N/A
if
$@;
1
N/A
1
N/A
my
$v =
$volumes
{
$platform
} ||
''
;
1
N/A
my
$other_v
=
$other_vols
{
$platform
} ||
''
;
1
N/A
1
N/A
# Fake out the rootdir on MacOS
1
N/A
no
strict
'refs'
;
1
N/A
my
$save_w
= $^W;
1
N/A
$^W =
0
;
1
N/A
local
*{
"File::Spec::Mac::rootdir"
} =
sub
{
"Macintosh HD:"
};
1
N/A
$^W =
$save_w
;
1
N/A
use
strict
'refs'
;
1
N/A
1
N/A
my
(
$file
,
$base
,
$result
)
;
1
N/A
1
N/A
$base
=
$module
->
catpath
($v,
$module
->
catdir
(
''
,
'foo'
)
,
''
)
;
1
N/A
$base
=
$module
->
catdir
(
$module
->
rootdir
,
'foo'
)
;
1
N/A
1
N/A
is
$module
->
file_name_is_absolute
(
$base
)
,
1
,
"
$base
is absolute on
$platform
"
;
1
N/A
1
N/A
1
N/A
# abs2rel('A:/
foo
/
bar
', 'A:/foo') -> 'bar'
1
N/A
$file
=
$module
->
catpath
($v,
$module
->
catdir
(
$module
->
rootdir
,
'foo'
,
'bar'
)
,
'file'
)
;
1
N/A
$base
=
$module
->
catpath
($v,
$module
->
catdir
(
$module
->
rootdir
,
'foo'
)
,
''
)
;
1
N/A
$result
=
$module
->
catfile
(
'bar'
,
'file'
)
;
1
N/A
is
$module
->
abs2rel
(
$file
,
$base
)
,
$result
,
"
$platform
->abs2rel(
$file
,
$base
)"
;
1
N/A
1
N/A
# abs2rel('A:/
foo
/
bar
', 'B:/foo') -> 'A:/
foo
/
bar
'
1
N/A
$base
=
$module
->
catpath
(
$other_v
,
$module
->
catdir
(
$module
->
rootdir
,
'foo'
)
,
''
)
;
1
N/A
$result
=
volumes_differ
(
$module
,
$file
,
$base
)
?
$file
:
$module
->
catfile
(
'bar'
,
'file'
)
;
1
N/A
is
$module
->
abs2rel
(
$file
,
$base
)
,
$result
,
"
$platform
->abs2rel(
$file
,
$base
)"
;
1
N/A
1
N/A
# abs2rel('A:/
foo
/
bar
', '/foo') -> 'A:/
foo
/
bar
'
1
N/A
$base
=
$module
->
catpath
(
''
,
$module
->
catdir
(
$module
->
rootdir
,
'foo'
)
,
''
)
;
1
N/A
$result
=
volumes_differ
(
$module
,
$file
,
$base
)
?
$file
:
$module
->
catfile
(
'bar'
,
'file'
)
;
1
N/A
is
$module
->
abs2rel
(
$file
,
$base
)
,
$result
,
"
$platform
->abs2rel(
$file
,
$base
)"
;
1
N/A
1
N/A
# abs2rel('/
foo
/
bar
', 'A:/foo') -> '/
foo
/
bar
'
1
N/A
$file
=
$module
->
catpath
(
''
,
$module
->
catdir
(
$module
->
rootdir
,
'foo'
,
'bar'
)
,
'file'
)
;
1
N/A
$base
=
$module
->
catpath
($v,
$module
->
catdir
(
$module
->
rootdir
,
'foo'
)
,
''
)
;
1
N/A
$result
=
volumes_differ
(
$module
,
$file
,
$base
)
?
$file
:
$module
->
catfile
(
'bar'
,
'file'
)
;
1
N/A
is
$module
->
abs2rel
(
$file
,
$base
)
,
$result
,
"
$platform
->abs2rel(
$file
,
$base
)"
;
1
N/A
1
N/A
# abs2rel('/
foo
/
bar
', 'B:/foo') -> '/
foo
/
bar
'
1
N/A
$base
=
$module
->
catpath
(
$other_v
,
$module
->
catdir
(
$module
->
rootdir
,
'foo'
)
,
''
)
;
1
N/A
$result
=
volumes_differ
(
$module
,
$file
,
$base
)
?
$file
:
$module
->
catfile
(
'bar'
,
'file'
)
;
1
N/A
is
$module
->
abs2rel
(
$file
,
$base
)
,
$result
,
"
$platform
->abs2rel(
$file
,
$base
)"
;
1
N/A
1
N/A
# abs2rel('/
foo
/
bar
', '/foo') -> 'bar'
1
N/A
$base
=
$module
->
catpath
(
''
,
$module
->
catdir
(
$module
->
rootdir
,
'foo'
)
,
''
)
;
1
N/A
$result
=
$module
->
catfile
(
'bar'
,
'file'
)
;
1
N/A
is
$module
->
abs2rel
(
$file
,
$base
)
,
$result
,
"
$platform
->abs2rel(
$file
,
$base
)"
;
1
N/A
}
1
N/A
}
1
N/A
1
N/A
sub
volumes_differ
{
1
N/A
my
(
$module
,
$one
,
$two
)
= @_;
1
N/A
my
(
$one_v
)
=
$module
->
splitpath
(
$module
->
rel2abs
(
$one
)
)
;
1
N/A
my
(
$two_v
)
=
$module
->
splitpath
(
$module
->
rel2abs
(
$two
)
)
;
1
N/A
return
$one_v
ne
$two_v
;
1
N/A
}