1*6fb12b70Safresh1#!./perl 2*6fb12b70Safresh1 3*6fb12b70Safresh1use File::Spec; 4*6fb12b70Safresh1use lib File::Spec->catdir('t', 'lib'); 5*6fb12b70Safresh1use Test::More; 6*6fb12b70Safresh1 7*6fb12b70Safresh1if( $^O eq 'MSWin32' ) { 8*6fb12b70Safresh1 plan tests => 4; 9*6fb12b70Safresh1} else { 10*6fb12b70Safresh1 plan skip_all => 'this is not win32'; 11*6fb12b70Safresh1} 12*6fb12b70Safresh1 13*6fb12b70Safresh1use Cwd; 14*6fb12b70Safresh1ok 1; 15*6fb12b70Safresh1 16*6fb12b70Safresh1my $cdir = getdcwd('C:'); 17*6fb12b70Safresh1like $cdir, qr{^C:}i; 18*6fb12b70Safresh1 19*6fb12b70Safresh1my $ddir = getdcwd('D:'); 20*6fb12b70Safresh1if (defined $ddir) { 21*6fb12b70Safresh1 like $ddir, qr{^D:}i; 22*6fb12b70Safresh1} else { 23*6fb12b70Safresh1 # May not have a D: drive mounted 24*6fb12b70Safresh1 ok 1; 25*6fb12b70Safresh1} 26*6fb12b70Safresh1 27*6fb12b70Safresh1# Ensure compatibility with naughty versions of Template::Toolkit, 28*6fb12b70Safresh1# which pass in a bare $1 as an argument 29*6fb12b70Safresh1'Foo/strawberry' =~ /(.*)/; 30*6fb12b70Safresh1my $result = File::Spec::Win32->catfile('C:/cache', $1); 31*6fb12b70Safresh1is( $result, 'C:\cache\Foo\strawberry' ); 32*6fb12b70Safresh1 33