1N/A#!./perl
1N/A
1N/Ause Cwd;
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A}
1N/A
1N/Ause Config;
1N/Ause strict;
1N/Ause warnings;
1N/Ause File::Spec;
1N/Ause File::Path;
1N/A
1N/Ause Test::More tests => 20;
1N/A
1N/Amy $IsVMS = $^O eq 'VMS';
1N/Amy $IsMacOS = $^O eq 'MacOS';
1N/A
1N/A# check imports
1N/Acan_ok('main', qw(cwd getcwd fastcwd fastgetcwd));
1N/Aok( !defined(&chdir), 'chdir() not exported by default' );
1N/Aok( !defined(&abs_path), ' nor abs_path()' );
1N/Aok( !defined(&fast_abs_path), ' nor fast_abs_path()');
1N/A
1N/A
1N/A# XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
1N/A# XXX and subsequent chdir()s can make them impossible to find
1N/Aeval { fastcwd };
1N/A
1N/A# Must find an external pwd (or equivalent) command.
1N/A
1N/Amy $pwd = $^O eq 'MSWin32' ? "cmd" : "pwd";
1N/Amy $pwd_cmd =
1N/A ($^O eq "NetWare") ?
1N/A "cd" :
1N/A ($IsMacOS) ?
1N/A "pwd" :
1N/A (grep { -x && -f } map { "$_/$pwd$Config{exe_ext}" }
1N/A split m/$Config{path_sep}/, $ENV{PATH})[0];
1N/A
1N/A$pwd_cmd = 'SHOW DEFAULT' if $IsVMS;
1N/Aif ($^O eq 'MSWin32') {
1N/A $pwd_cmd =~ s,/,\\,g;
1N/A $pwd_cmd = "$pwd_cmd /c cd";
1N/A}
1N/A$pwd_cmd =~ s=\\=/=g if ($^O eq 'dos');
1N/A
1N/ASKIP: {
1N/A skip "No native pwd command found to test against", 4 unless $pwd_cmd;
1N/A
1N/A print "# native pwd = '$pwd_cmd'\n";
1N/A
1N/A local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
1N/A my ($pwd_cmd_untainted) = $pwd_cmd =~ /^(.+)$/; # Untaint.
1N/A chomp(my $start = `$pwd_cmd_untainted`);
1N/A
1N/A # Win32's cd returns native C:\ style
1N/A $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
1N/A # DCL SHOW DEFAULT has leading spaces
1N/A $start =~ s/^\s+// if $IsVMS;
1N/A SKIP: {
1N/A skip("'$pwd_cmd' failed, nothing to test against", 4) if $?;
1N/A skip("/afs seen, paths unlikely to match", 4) if $start =~ m|/afs/|;
1N/A
1N/A # Darwin's getcwd(3) (which Cwd.xs:bsd_realpath() uses which
1N/A # Cwd.pm:getcwd uses) has some magic related to the PWD
1N/A # environment variable: if PWD is set to a directory that
1N/A # looks about right (guess: has the same (dev,ino) as the '.'?),
1N/A # the PWD is returned. However, if that path contains
1N/A # symlinks, the path will not be equal to the one returned by
1N/A # /bin/pwd (which probably uses the usual walking upwards in
1N/A # the path -trick). This situation is easy to reproduce since
1N/A # /tmp is a symlink to /private/tmp. Therefore we invalidate
1N/A # the PWD to force getcwd(3) to (re)compute the cwd in full.
1N/A # Admittedly fixing this in the Cwd module would be better
1N/A # long-term solution but deleting $ENV{PWD} should not be
1N/A # done light-heartedly. --jhi
1N/A delete $ENV{PWD} if $^O eq 'darwin';
1N/A
1N/A my $cwd = cwd;
1N/A my $getcwd = getcwd;
1N/A my $fastcwd = fastcwd;
1N/A my $fastgetcwd = fastgetcwd;
1N/A
1N/A is($cwd, $start, 'cwd()');
1N/A is($getcwd, $start, 'getcwd()');
1N/A is($fastcwd, $start, 'fastcwd()');
1N/A is($fastgetcwd, $start, 'fastgetcwd()');
1N/A }
1N/A}
1N/A
1N/Amy @test_dirs = qw{_ptrslt_ _path_ _to_ _a_ _dir_};
1N/Amy $Test_Dir = File::Spec->catdir(@test_dirs);
1N/A
1N/Amkpath([$Test_Dir], 0, 0777);
1N/ACwd::chdir $Test_Dir;
1N/A
1N/Aforeach my $func (qw(cwd getcwd fastcwd fastgetcwd)) {
1N/A my $result = eval "$func()";
1N/A is $@, '';
1N/A dir_ends_with( $result, $Test_Dir, "$func()" );
1N/A}
1N/A
1N/A# Cwd::chdir should also update $ENV{PWD}
1N/Adir_ends_with( $ENV{PWD}, $Test_Dir, 'Cwd::chdir() updates $ENV{PWD}' );
1N/Amy $updir = File::Spec->updir;
1N/ACwd::chdir $updir;
1N/Aprint "#$ENV{PWD}\n";
1N/ACwd::chdir $updir;
1N/Aprint "#$ENV{PWD}\n";
1N/ACwd::chdir $updir;
1N/Aprint "#$ENV{PWD}\n";
1N/ACwd::chdir $updir;
1N/Aprint "#$ENV{PWD}\n";
1N/ACwd::chdir $updir;
1N/Aprint "#$ENV{PWD}\n";
1N/A
1N/Armtree($test_dirs[0], 0, 0);
1N/A
1N/A{
1N/A my $check = ($IsVMS ? qr|\b((?i)t)\]$| :
1N/A $IsMacOS ? qr|\bt:$| :
1N/A qr|\bt$| );
1N/A
1N/A like($ENV{PWD}, $check);
1N/A}
1N/A
1N/ASKIP: {
1N/A skip "no symlinks on this platform", 2 unless $Config{d_symlink};
1N/A
1N/A mkpath([$Test_Dir], 0, 0777);
1N/A symlink $Test_Dir => "linktest";
1N/A
1N/A my $abs_path = Cwd::abs_path("linktest");
1N/A my $fast_abs_path = Cwd::fast_abs_path("linktest");
1N/A my $want = File::Spec->catdir("t", $Test_Dir);
1N/A
1N/A like($abs_path, qr|$want$|);
1N/A like($fast_abs_path, qr|$want$|);
1N/A
1N/A rmtree($test_dirs[0], 0, 0);
1N/A unlink "linktest";
1N/A}
1N/A
1N/A#############################################
1N/A# These two routines give us sort of a poor-man's cross-platform
1N/A# directory comparison routine.
1N/A
1N/Asub bracketed_form {
1N/A return join '', map "[$_]",
1N/A grep length, File::Spec->splitdir(File::Spec->canonpath( shift() ));
1N/A}
1N/A
1N/Asub dir_ends_with {
1N/A my ($dir, $expect) = (shift, shift);
1N/A my $bracketed_expect = quotemeta bracketed_form($expect);
1N/A like( bracketed_form($dir), qr|$bracketed_expect$|i, (@_ ? shift : ()) );
1N/A}
1N/A