This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
/cygdrive is configurable
[perl5.git] / t / lib / cygwin.t
CommitLineData
49fd6edc
YST
1#!perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = ('../lib');
6 unless ($^O eq "cygwin") {
7 print "1..0 # skipped: cygwin specific test\n";
8 exit 0;
9 }
10}
11
74dc058d 12use Test::More tests => 16;
49fd6edc
YST
13
14is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($$)), $$,
15 "perl pid translates to itself");
16
17my $parent = getppid;
18SKIP: {
19 skip "test not run from cygwin process", 1 if $parent <= 1;
20 is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($parent)), $parent,
21 "parent pid translates to itself");
22}
23
24my $catpid = open my $cat, "|cat" or die "Couldn't cat: $!";
25open my $ps, "ps|" or die "Couldn't do ps: $!";
26my ($catwinpid) = map /^.\s+$catpid\s+\d+\s+\d+\s+(\d+)/, <$ps>;
27close($ps);
28
29is(Cygwin::winpid_to_pid($catwinpid), $catpid, "winpid to pid");
30is(Cygwin::pid_to_winpid($catpid), $catwinpid, "pid to winpid");
31close($cat);
15414d2b
RU
32
33is(Cygwin::win_to_posix_path("t\\lib"), "t/lib", "win to posix path: t/lib");
34is(Cygwin::posix_to_win_path("t/lib"), "t\\lib", "posix to win path: t\\lib");
35
36use Win32;
37use Cwd;
a25ce5f3 38my $pwd = getcwd();
15414d2b 39chdir("/");
a25ce5f3 40my $winpath = Win32::GetCwd();
15414d2b
RU
41is(Cygwin::posix_to_win_path("/", 1), $winpath, "posix to absolute win path");
42chdir($pwd);
43is(Cygwin::win_to_posix_path($winpath, 1), "/", "win to absolute posix path");
a25ce5f3
RU
44
45my $mount = join '', `/usr/bin/mount`;
46$mount =~ m|on /usr/bin type .+ \((\w+mode)\)|m;
47my $binmode = $1 eq 'binmode';
48is(Cygwin::is_binmount("/"), $binmode ? 1 : '', "check / for binmount");
a25ce5f3
RU
49
50my $rootmnt = Cygwin::mount_flags("/");
51ok($binmode ? ($rootmnt =~ /,binmode/) : ($rootmnt =~ /,textmode/), "check / mount_flags");
52is(Cygwin::mount_flags("/cygdrive") =~ /,cygdrive/, 1, "check cygdrive mount_flags");
53
74dc058d
JH
54# Cygdrive mount prefix
55my @flags = split(/,/, Cygwin::mount_flags('/cygdrive'));
56my $prefix = pop(@flags);
57ok($prefix, "cygdrive mount prefix = " . (($prefix) ? $prefix : '<none>'));
58chomp(my $prefix2 = `df | grep -i '^c: ' | cut -d% -f2 | xargs`);
59$prefix2 =~ s/\/c$//i;
60if (! $prefix2) {
61 $prefix2 = '/';
62}
63is($prefix, $prefix2, 'cygdrive mount prefix');
64
a25ce5f3
RU
65my @mnttbl = Cygwin::mount_table();
66ok(@mnttbl > 0, "non empty mount_table");
67for $i (@mnttbl) {
68 if ($i->[0] eq '/') {
69 is($i->[2].",".$i->[3], $rootmnt, "same root mount flags");
fa5b08bc 70 last;
a25ce5f3
RU
71 }
72}
482150a7
JH
73
74ok(Cwd->cwd(), "bug#38628 legacy");