1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
#!./perl
use Cwd;
BEGIN {
chdir 't' if -d 't';
}
use Config;
use strict;
use warnings;
use File::Spec;
use File::Path;
use Test::More tests => 20;
my $IsVMS = $^O eq 'VMS';
my $IsMacOS = $^O eq 'MacOS';
# check imports
can_ok('main', qw(cwd getcwd fastcwd fastgetcwd));
ok( !defined(&chdir), 'chdir() not exported by default' );
ok( !defined(&abs_path), ' nor abs_path()' );
ok( !defined(&fast_abs_path), ' nor fast_abs_path()');
# XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
# XXX and subsequent chdir()s can make them impossible to find
eval { fastcwd };
# Must find an external pwd (or equivalent) command.
my $pwd = $^O eq 'MSWin32' ? "cmd" : "pwd";
my $pwd_cmd =
($^O eq "NetWare") ?
"cd" :
($IsMacOS) ?
"pwd" :
(grep { -x && -f } map { "$_/$pwd$Config{exe_ext}" }
split m/$Config{path_sep}/, $ENV{PATH})[0];
$pwd_cmd = 'SHOW DEFAULT' if $IsVMS;
if ($^O eq 'MSWin32') {
$pwd_cmd =~ s,/,\\,g;
$pwd_cmd = "$pwd_cmd /c cd";
}
$pwd_cmd =~ s=\\=/=g if ($^O eq 'dos');
SKIP: {
skip "No native pwd command found to test against", 4 unless $pwd_cmd;
print "# native pwd = '$pwd_cmd'\n";
local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
my ($pwd_cmd_untainted) = $pwd_cmd =~ /^(.+)$/; # Untaint.
chomp(my $start = `$pwd_cmd_untainted`);
# Win32's cd returns native C:\ style
$start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
# DCL SHOW DEFAULT has leading spaces
$start =~ s/^\s+// if $IsVMS;
SKIP: {
skip("'$pwd_cmd' failed, nothing to test against", 4) if $?;
skip("/afs seen, paths unlikely to match", 4) if $start =~ m|/afs/|;
# Darwin's getcwd(3) (which Cwd.xs:bsd_realpath() uses which
# Cwd.pm:getcwd uses) has some magic related to the PWD
# environment variable: if PWD is set to a directory that
# looks about right (guess: has the same (dev,ino) as the '.'?),
# the PWD is returned. However, if that path contains
# symlinks, the path will not be equal to the one returned by
# /bin/pwd (which probably uses the usual walking upwards in
# the path -trick). This situation is easy to reproduce since
# /tmp is a symlink to /private/tmp. Therefore we invalidate
# the PWD to force getcwd(3) to (re)compute the cwd in full.
# Admittedly fixing this in the Cwd module would be better
# long-term solution but deleting $ENV{PWD} should not be
# done light-heartedly. --jhi
delete $ENV{PWD} if $^O eq 'darwin';
my $cwd = cwd;
my $getcwd = getcwd;
my $fastcwd = fastcwd;
my $fastgetcwd = fastgetcwd;
is($cwd, $start, 'cwd()');
is($getcwd, $start, 'getcwd()');
is($fastcwd, $start, 'fastcwd()');
is($fastgetcwd, $start, 'fastgetcwd()');
}
}
my $Top_Test_Dir = '_ptrslt_';
my $Test_Dir = File::Spec->catdir($Top_Test_Dir, qw/_path_ _to_ _a_ _dir_/);
my $want = quotemeta File::Spec->rel2abs($Test_Dir);
mkpath([$Test_Dir], 0, 0777);
Cwd::chdir $Test_Dir;
foreach my $func (qw(cwd getcwd fastcwd fastgetcwd)) {
my $result = eval "$func()";
is $@, '';
like( File::Spec->canonpath($result), qr|$want$|i, "$func()" );
}
# Cwd::chdir should also update $ENV{PWD}
like(File::Spec->canonpath($ENV{PWD}), qr|$want$|i, 'Cwd::chdir() updates $ENV{PWD}');
my $updir = File::Spec->updir;
Cwd::chdir $updir;
print "#$ENV{PWD}\n";
Cwd::chdir $updir;
print "#$ENV{PWD}\n";
Cwd::chdir $updir;
print "#$ENV{PWD}\n";
Cwd::chdir $updir;
print "#$ENV{PWD}\n";
Cwd::chdir $updir;
print "#$ENV{PWD}\n";
rmtree([$Top_Test_Dir], 0, 0);
{
my $check = ($IsVMS ? qr|\b((?i)t)\]$| :
$IsMacOS ? qr|\bt:$| :
qr|\bt$| );
like($ENV{PWD}, $check);
}
SKIP: {
skip "no symlinks on this platform", 2 unless $Config{d_symlink};
mkpath([$Test_Dir], 0, 0777);
symlink $Test_Dir => "linktest";
my $abs_path = Cwd::abs_path("linktest");
my $fast_abs_path = Cwd::fast_abs_path("linktest");
my $want = File::Spec->catdir("t", $Test_Dir);
like($abs_path, qr|$want$|);
like($fast_abs_path, qr|$want$|);
rmtree([$Top_Test_Dir], 0, 0);
unlink "linktest";
}
|
