ext/Cwd/t/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 use File::Spec;
  13 use File::Path;
  14
  15 use Test::More tests => 16;
  16
  17 my $IsVMS = $^O eq 'VMS';
  18 my $IsMacOS = $^O eq 'MacOS';
  19
  20 # check imports
  21 can_ok('main', qw(cwd getcwd fastcwd fastgetcwd));
  22 ok( !defined(&chdir),           'chdir() not exported by default' );
  23 ok( !defined(&abs_path),        '  nor abs_path()' );
  24 ok( !defined(&fast_abs_path),   '  nor fast_abs_path()');
  25
  26
  27 # XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
  28 # XXX and subsequent chdir()s can make them impossible to find
  29 eval { fastcwd };
  30
  31 # Must find an external pwd (or equivalent) command.
  32
  33 my $pwd = $^O eq 'MSWin32' ? "cmd" : "pwd";
  34 my $pwd_cmd =
  35     ($^O eq "NetWare") ?
  36         "cd" :
  37     ($IsMacOS) ?
  38         "pwd" :
  39         (grep { -x && -f } map { "$_/$pwd$Config{exe_ext}" }
  40                            split m/$Config{path_sep}/, $ENV{PATH})[0];
  41
  42 $pwd_cmd = 'SHOW DEFAULT' if $IsVMS;
  43 if ($^O eq 'MSWin32') {
  44     $pwd_cmd =~ s,/,\\,g;
  45     $pwd_cmd = "$pwd_cmd /c cd";
  46 }
  47 $pwd_cmd =~ s=\\=/=g if ($^O eq 'dos');
  48
  49 print "# native pwd = '$pwd_cmd'\n";
  50
  51 SKIP: {
  52     skip "No native pwd command found to test against", 4 unless $pwd_cmd;
  53
  54     local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
  55     my ($pwd_cmd_untainted) = $pwd_cmd =~ /^(.+)$/; # Untaint.
  56     chomp(my $start = `$pwd_cmd_untainted`);
  57
  58     # Win32's cd returns native C:\ style
  59     $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
  60     # DCL SHOW DEFAULT has leading spaces
  61     $start =~ s/^\s+// if $IsVMS;
  62     SKIP: {
  63         skip "'$pwd_cmd' failed, nothing to test against", 4 if $?;
  64
  65         my $cwd        = cwd;
  66         my $getcwd     = getcwd;
  67         my $fastcwd    = fastcwd;
  68         my $fastgetcwd = fastgetcwd;
  69         is(cwd(),       $start, 'cwd()');
  70         is(getcwd(),    $start, 'getcwd()');
  71         is(fastcwd(),   $start, 'fastcwd()');
  72         is(fastgetcwd(),$start, 'fastgetcwd()');
  73     }
  74 }
  75
  76 my $Top_Test_Dir = '_ptrslt_';
  77 my $Test_Dir     = "$Top_Test_Dir/_path_/_to_/_a_/_dir_";
  78 my $want = "t/$Test_Dir";
  79 if( $IsVMS ) {
  80     # translate the unixy path to VMSish
  81     $want =~ s|/|\.|g;
  82     $want .= '\]';
  83     $want = '((?i)' . $want . ')';  # might be ODS-2 or ODS-5
  84 } elsif ( $IsMacOS ) {
  85     $_ = ":$_" for ($Top_Test_Dir, $Test_Dir);
  86     s|/|:|g, s|$|:| for ($want, $Test_Dir);
  87 }
  88
  89 mkpath(["$Test_Dir"], 0, 0777);
  90 Cwd::chdir "$Test_Dir";
  91
  92 like(cwd(),        qr|$want$|, 'chdir() + cwd()');
  93 like(getcwd(),     qr|$want$|, '        + getcwd()');
  94 like(fastcwd(),    qr|$want$|, '        + fastcwd()');
  95 like(fastgetcwd(), qr|$want$|, '        + fastgetcwd()');
  96
  97 # Cwd::chdir should also update $ENV{PWD}
  98 like($ENV{PWD}, qr|$want$|,      'Cwd::chdir() updates $ENV{PWD}');
  99 my $updir = File::Spec->updir;
 100 Cwd::chdir $updir;
 101 print "#$ENV{PWD}\n";
 102 Cwd::chdir $updir;
 103 print "#$ENV{PWD}\n";
 104 Cwd::chdir $updir;
 105 print "#$ENV{PWD}\n";
 106 Cwd::chdir $updir;
 107 print "#$ENV{PWD}\n";
 108 Cwd::chdir $updir;
 109 print "#$ENV{PWD}\n";
 110
 111 rmtree([$Top_Test_Dir], 0, 0);
 112
 113 if ($IsVMS) {
 114     like($ENV{PWD}, qr|\b((?i)t)\]$|);
 115 }
 116 elsif ($IsMacOS) {
 117     like($ENV{PWD}, qr|\bt:$|);
 118 }
 119 else {
 120     like($ENV{PWD}, qr|\bt$|);
 121 }
 122
 123 SKIP: {
 124     skip "no symlinks on this platform", 2 unless $Config{d_symlink};
 125
 126     mkpath([$Test_Dir], 0, 0777);
 127     symlink $Test_Dir => "linktest";
 128
 129     my $abs_path      =  Cwd::abs_path("linktest");
 130     my $fast_abs_path =  Cwd::fast_abs_path("linktest");
 131     my $want          =  File::Spec->catdir("t", $Test_Dir) if $IsMacOS;
 132
 133     like($abs_path,      qr|$want$|);
 134     like($fast_abs_path, qr|$want$|);
 135
 136     rmtree([$Top_Test_Dir], 0, 0);
 137     unlink "linktest";
 138 }