t/lib/cygwin.t

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