t/lib/cwd.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use Config;
   9 use Cwd;
  10 use strict;
  11 use warnings;
  12
  13 print "1..14\n";
  14
  15 # check imports
  16 print +(defined(&cwd) &&
  17         defined(&getcwd) &&
  18         defined(&fastcwd) &&
  19         defined(&fastgetcwd) ?
  20         "" : "not "), "ok 1\n";
  21 print +(!defined(&chdir) &&
  22         !defined(&abs_path) &&
  23         !defined(&fast_abs_path) ?
  24         "" : "not "), "ok 2\n";
  25
  26 # Must find an external pwd (or equivalent) command.
  27
  28 my $pwd_cmd =
  29     ($^O eq "MSWin32") ? "cd" : (grep { -x && -f } map { "$_/pwd" }
  30                                split m/$Config{path_sep}/, $ENV{PATH})[0];
  31
  32 if (defined $pwd_cmd) {
  33     chomp(my $start = `$pwd_cmd`);
  34     # Win32's cd returns native C:\ style
  35     $start =~ s,\\,/,g if $^O eq 'MSWin32';
  36     if ($?) {
  37         for (3..6) {
  38             print "ok $_ # Skip: '$pwd_cmd' failed\n";
  39         }
  40     } else {
  41         my $cwd        = cwd;
  42         my $getcwd     = getcwd;
  43         my $fastcwd    = fastcwd;
  44         my $fastgetcwd = fastgetcwd;
  45         print +($cwd        eq $start ? "" : "not "), "ok 3\n";
  46         print +($getcwd     eq $start ? "" : "not "), "ok 4\n";
  47         print +($fastcwd    eq $start ? "" : "not "), "ok 5\n";
  48         print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
  49     }
  50 } else {
  51     for (3..6) {
  52         print "ok $_ # Skip: no pwd command found\n";
  53     }
  54 }
  55
  56 mkdir "pteerslt", 0777;
  57 mkdir "pteerslt/path", 0777;
  58 mkdir "pteerslt/path/to", 0777;
  59 mkdir "pteerslt/path/to/a", 0777;
  60 mkdir "pteerslt/path/to/a/dir", 0777;
  61 Cwd::chdir "pteerslt/path/to/a/dir";
  62 my $cwd        = cwd;
  63 my $getcwd     = getcwd;
  64 my $fastcwd    = fastcwd;
  65 my $fastgetcwd = fastgetcwd;
  66 my $want = "t/pteerslt/path/to/a/dir";
  67 print +($cwd        =~ m|$want$| ? "" : "not "), "ok 7\n";
  68 print +($getcwd     =~ m|$want$| ? "" : "not "), "ok 8\n";
  69 print +($fastcwd    =~ m|$want$| ? "" : "not "), "ok 9\n";
  70 print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
  71
  72 # Cwd::chdir should also update $ENV{PWD}
  73 print "#$ENV{PWD}\n";
  74 print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
  75 Cwd::chdir ".."; rmdir "dir";
  76 print "#$ENV{PWD}\n";
  77 Cwd::chdir ".."; rmdir "a";
  78 print "#$ENV{PWD}\n";
  79 Cwd::chdir ".."; rmdir "to";
  80 print "#$ENV{PWD}\n";
  81 Cwd::chdir ".."; rmdir "path";
  82 print "#$ENV{PWD}\n";
  83 Cwd::chdir ".."; rmdir "pteerslt";
  84 print "#$ENV{PWD}\n";
  85 print +($ENV{PWD}  =~ m|\bt$| ? "" : "not "), "ok 12\n";
  86
  87 if ($Config{d_symlink}) {
  88     my @dirs = split " " => $Config{libpth};
  89     my $target = pop @dirs;
  90     symlink $target => "linktest";
  91     mkdir "pteerslt";
  92     chdir "pteerslt";
  93     my $rel = "../../t/linktest";
  94
  95     my $abs_path      = Cwd::abs_path($rel);
  96     my $fast_abs_path = Cwd::fast_abs_path($rel);
  97     print +($abs_path      eq $target ? "" : "not "), "ok 13\n";
  98     print +($fast_abs_path eq $target ? "" : "not "), "ok 14\n";
  99
 100     chdir "..";
 101     rmdir "pteerslt";
 102     unlink "linktest";
 103 } else {
 104     print "ok 13 # skipped\n";
 105     print "ok 14 # skipped\n";
 106 }