diff options
Diffstat (limited to 'ext/Cwd/Cwd.t')
| -rw-r--r-- | ext/Cwd/Cwd.t | 134 |
1 files changed, 134 insertions, 0 deletions
diff --git a/ext/Cwd/Cwd.t b/ext/Cwd/Cwd.t new file mode 100644 index 0000000000..09b45d6004 --- /dev/null +++ b/ext/Cwd/Cwd.t @@ -0,0 +1,134 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Config; +use Cwd; +use strict; +use warnings; + +print "1..14\n"; + +# check imports +print +(defined(&cwd) && + defined(&getcwd) && + defined(&fastcwd) && + defined(&fastgetcwd) ? + "" : "not "), "ok 1\n"; +print +(!defined(&chdir) && + !defined(&abs_path) && + !defined(&fast_abs_path) ? + "" : "not "), "ok 2\n"; + +# 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_cmd = + ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd" } + split m/$Config{path_sep}/, $ENV{PATH})[0]; + +if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; } + +if (defined $pwd_cmd) { + chomp(my $start = `$pwd_cmd`); + # 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 $^O eq 'VMS'; + if ($?) { + for (3..6) { + print "ok $_ # Skip: '$pwd_cmd' failed\n"; + } + } else { + my $cwd = cwd; + my $getcwd = getcwd; + my $fastcwd = fastcwd; + my $fastgetcwd = fastgetcwd; + print +($cwd eq $start ? "" : "not "), "ok 3\n"; + print +($getcwd eq $start ? "" : "not "), "ok 4\n"; + print +($fastcwd eq $start ? "" : "not "), "ok 5\n"; + print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n"; + } +} else { + for (3..6) { + print "ok $_ # Skip: no pwd command found\n"; + } +} + +mkdir "pteerslt", 0777; +mkdir "pteerslt/path", 0777; +mkdir "pteerslt/path/to", 0777; +mkdir "pteerslt/path/to/a", 0777; +mkdir "pteerslt/path/to/a/dir", 0777; +Cwd::chdir "pteerslt/path/to/a/dir"; +my $cwd = cwd; +my $getcwd = getcwd; +my $fastcwd = fastcwd; +my $fastgetcwd = fastgetcwd; +my $want = "t/pteerslt/path/to/a/dir"; +print "# cwd = '$cwd'\n"; +print "# getcwd = '$getcwd'\n"; +print "# fastcwd = '$fastcwd'\n"; +print "# fastgetcwd = '$fastgetcwd'\n"; +# This checked out OK on ODS-2 and ODS-5: +$want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS'; +print +($cwd =~ m|$want$| ? "" : "not "), "ok 7\n"; +print +($getcwd =~ m|$want$| ? "" : "not "), "ok 8\n"; +print +($fastcwd =~ m|$want$| ? "" : "not "), "ok 9\n"; +print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n"; + +# Cwd::chdir should also update $ENV{PWD} +print "#$ENV{PWD}\n"; +print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n"; +Cwd::chdir ".."; rmdir "dir"; +print "#$ENV{PWD}\n"; +Cwd::chdir ".."; rmdir "a"; +print "#$ENV{PWD}\n"; +Cwd::chdir ".."; rmdir "to"; +print "#$ENV{PWD}\n"; +Cwd::chdir ".."; rmdir "path"; +print "#$ENV{PWD}\n"; +Cwd::chdir ".."; rmdir "pteerslt"; +print "#$ENV{PWD}\n"; +if ($^O eq 'VMS') { + # This checked out OK on ODS-2 and ODS-5: + print +($ENV{PWD} =~ m|\bT\]$| ? "" : "not "), "ok 12\n"; +} +else { + print +($ENV{PWD} =~ m|\bt$| ? "" : "not "), "ok 12\n"; +} + +if ($Config{d_symlink}) { + mkdir "pteerslt", 0777; + mkdir "pteerslt/path", 0777; + mkdir "pteerslt/path/to", 0777; + mkdir "pteerslt/path/to/a", 0777; + mkdir "pteerslt/path/to/a/dir", 0777; + symlink "pteerslt/path/to/a/dir" => "linktest"; + + my $abs_path = Cwd::abs_path("linktest"); + my $fast_abs_path = Cwd::fast_abs_path("linktest"); + my $want = "t/pteerslt/path/to/a/dir"; + + print "# abs_path $abs_path\n"; + print "# fast_abs_path $fast_abs_path\n"; + print "# want $want\n"; + print +($abs_path =~ m|$want$| ? "" : "not "), "ok 13\n"; + print +($fast_abs_path =~ m|$want$| ? "" : "not "), "ok 14\n"; + + rmdir "pteerslt/path/to/a/dir"; + rmdir "pteerslt/path/to/a"; + rmdir "pteerslt/path/to"; + rmdir "pteerslt/path"; + rmdir "pteerslt"; + unlink "linktest"; +} else { + print "ok 13 # skipped\n"; + print "ok 14 # skipped\n"; +} |