ext/Cwd/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 # XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
  27 # XXX and subsequent chdir()s can make them impossible to find
  28 eval { fastcwd };
  29
  30 # Must find an external pwd (or equivalent) command.
  31
  32 my $pwd_cmd =
  33     ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd" }
  34                                split m/$Config{path_sep}/, $ENV{PATH})[0];
  35
  36 if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; }
  37
  38 if (defined $pwd_cmd) {
  39     chomp(my $start = `$pwd_cmd`);
  40     # Win32's cd returns native C:\ style
  41     $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
  42     # DCL SHOW DEFAULT has leading spaces
  43     $start =~ s/^\s+// if $^O eq 'VMS';
  44     if ($?) {
  45         for (3..6) {
  46             print "ok $_ # Skip: '$pwd_cmd' failed\n";
  47         }
  48     } else {
  49         my $cwd        = cwd;
  50         my $getcwd     = getcwd;
  51         my $fastcwd    = fastcwd;
  52         my $fastgetcwd = fastgetcwd;
  53         print +($cwd        eq $start ? "" : "not "), "ok 3\n";
  54         print +($getcwd     eq $start ? "" : "not "), "ok 4\n";
  55         print +($fastcwd    eq $start ? "" : "not "), "ok 5\n";
  56         print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
  57     }
  58 } else {
  59     for (3..6) {
  60         print "ok $_ # Skip: no pwd command found\n";
  61     }
  62 }
  63
  64 mkdir "pteerslt", 0777;
  65 mkdir "pteerslt/path", 0777;
  66 mkdir "pteerslt/path/to", 0777;
  67 mkdir "pteerslt/path/to/a", 0777;
  68 mkdir "pteerslt/path/to/a/dir", 0777;
  69 Cwd::chdir "pteerslt/path/to/a/dir";
  70 my $cwd        = cwd;
  71 my $getcwd     = getcwd;
  72 my $fastcwd    = fastcwd;
  73 my $fastgetcwd = fastgetcwd;
  74 my $want = "t/pteerslt/path/to/a/dir";
  75 print "# cwd        = '$cwd'\n";
  76 print "# getcwd     = '$getcwd'\n";
  77 print "# fastcwd    = '$fastcwd'\n";
  78 print "# fastgetcwd = '$fastgetcwd'\n";
  79 # This checked out OK on ODS-2 and ODS-5:
  80 $want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS';
  81 print +($cwd        =~ m|$want$| ? "" : "not "), "ok 7\n";
  82 print +($getcwd     =~ m|$want$| ? "" : "not "), "ok 8\n";
  83 print +($fastcwd    =~ m|$want$| ? "" : "not "), "ok 9\n";
  84 print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
  85
  86 # Cwd::chdir should also update $ENV{PWD}
  87 print "#$ENV{PWD}\n";
  88 print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
  89 Cwd::chdir ".."; rmdir "dir";
  90 print "#$ENV{PWD}\n";
  91 Cwd::chdir ".."; rmdir "a";
  92 print "#$ENV{PWD}\n";
  93 Cwd::chdir ".."; rmdir "to";
  94 print "#$ENV{PWD}\n";
  95 Cwd::chdir ".."; rmdir "path";
  96 print "#$ENV{PWD}\n";
  97 Cwd::chdir ".."; rmdir "pteerslt";
  98 print "#$ENV{PWD}\n";
  99 if ($^O eq 'VMS') {
 100     # This checked out OK on ODS-2 and ODS-5:
 101     print +($ENV{PWD}  =~ m|\bT\]$| ? "" : "not "), "ok 12\n";
 102 }
 103 else {
 104     print +($ENV{PWD}  =~ m|\bt$| ? "" : "not "), "ok 12\n";
 105 }
 106
 107 if ($Config{d_symlink}) {
 108     mkdir "pteerslt", 0777;
 109     mkdir "pteerslt/path", 0777;
 110     mkdir "pteerslt/path/to", 0777;
 111     mkdir "pteerslt/path/to/a", 0777;
 112     mkdir "pteerslt/path/to/a/dir", 0777;
 113     symlink "pteerslt/path/to/a/dir" => "linktest";
 114
 115     my $abs_path      =  Cwd::abs_path("linktest");
 116     my $fast_abs_path =  Cwd::fast_abs_path("linktest");
 117     my $want          = "t/pteerslt/path/to/a/dir";
 118
 119     print "# abs_path      $abs_path\n";
 120     print "# fast_abs_path $fast_abs_path\n";
 121     print "# want          $want\n";
 122     print +($abs_path      =~ m|$want$| ? "" : "not "), "ok 13\n";
 123     print +($fast_abs_path =~ m|$want$| ? "" : "not "), "ok 14\n";
 124
 125     rmdir "pteerslt/path/to/a/dir";
 126     rmdir "pteerslt/path/to/a";
 127     rmdir "pteerslt/path/to";
 128     rmdir "pteerslt/path";
 129     rmdir "pteerslt";
 130     unlink "linktest";
 131 } else {
 132     print "ok 13 # skipped\n";
 133     print "ok 14 # skipped\n";
 134 }