Hack to remove insecure directories from PATH so test will run.

[p5sagit/p5-mst-13.2.git] / t / lib / cwd.t

#!./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") ? "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';
    # 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";
}