This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #126834] Cygwin cygdrive prefix test
authorAchim Gratz <Achim.Gratz@Stromeko.DE>
Wed, 9 Dec 2015 17:59:03 +0000 (18:59 +0100)
committerTony Cook <tony@develop-help.com>
Wed, 9 Dec 2015 22:29:42 +0000 (09:29 +1100)
* t/lib/cygwin.t: Use the /proc virtual filesystem to determine the
  cygdrive prefix.  If that isn't available, fall back to using the
  cygpath executable instead of parsing the output from df or mount
  for older Cygwin.  That fallback can fail if C:\ is manually mounted
  someplace else, but the former code had the same problem.

t/lib/cygwin.t

index a619e40..ba86170 100644 (file)
@@ -52,18 +52,16 @@ is(Cygwin::mount_flags("/cygdrive") =~ /,cygdrive/,  1, "check cygdrive mount_fl
 # Cygdrive mount prefix
 my @flags = split(/,/, Cygwin::mount_flags('/cygdrive'));
 my $prefix = pop(@flags);
-ok($prefix, "cygdrive mount prefix = " . (($prefix) ? $prefix : '<none>'));
-chomp(my $prefix2 = `df -a | grep -i '^c: ' | cut -d% -f2 | xargs`);
-# we get something like "C: - - - - /cygdrive" if this isn't the entry
-# df displays free space info for
-$prefix2 =~ s/.* //;
-$prefix2 =~ s/\/c$//i;
-SKIP:
-{
-    $prefix2
-       or skip("No C: entry found in df output", 1);
-    is($prefix, $prefix2, 'cygdrive mount prefix');
+ok($prefix, "cygdrive mount prefix  = " . (($prefix) ? $prefix : '<none>'));
+my $prefix2 = readlink "/proc/cygdrive";
+unless ($prefix2) {
+    # fallback to old Cygwin, the drive need not actually exist, so
+    # this will always work (but might return the wrong prefix if the
+    # user re-mounted C:\
+    chomp($prefix2 = `cygpath C:`);
+    $prefix2 = substr($prefix2, 0, -1-(length($prefix2)>2));
 }
+is($prefix, $prefix2, 'cygdrive mount prefix2 = ' . $prefix2);
 
 my @mnttbl = Cygwin::mount_table();
 ok(@mnttbl > 0, "non empty mount_table");