This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Cwd test not cleaning up after itself
[perl5.git] / ext / Cwd / t / cwd.t
CommitLineData
ed4a5f99
BS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8use Config;
9use Cwd;
10use strict;
11use warnings;
1279e177 12use File::Path;
ed4a5f99 13
da3f15f4 14print "1..14\n";
ed4a5f99
BS
15
16# check imports
17print +(defined(&cwd) &&
18 defined(&getcwd) &&
19 defined(&fastcwd) &&
20 defined(&fastgetcwd) ?
21 "" : "not "), "ok 1\n";
22print +(!defined(&chdir) &&
23 !defined(&abs_path) &&
24 !defined(&fast_abs_path) ?
25 "" : "not "), "ok 2\n";
26
0d2079fa
BS
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
29eval { fastcwd };
30
da3f15f4
JH
31# Must find an external pwd (or equivalent) command.
32
33my $pwd_cmd =
2986a63f 34 ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd" }
da3f15f4
JH
35 split m/$Config{path_sep}/, $ENV{PATH})[0];
36
2390ecbc
PP
37if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; }
38
da3f15f4
JH
39if (defined $pwd_cmd) {
40 chomp(my $start = `$pwd_cmd`);
14107c42 41 # Win32's cd returns native C:\ style
2986a63f 42 $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
2390ecbc
PP
43 # DCL SHOW DEFAULT has leading spaces
44 $start =~ s/^\s+// if $^O eq 'VMS';
da3f15f4
JH
45 if ($?) {
46 for (3..6) {
47 print "ok $_ # Skip: '$pwd_cmd' failed\n";
48 }
49 } else {
50 my $cwd = cwd;
51 my $getcwd = getcwd;
52 my $fastcwd = fastcwd;
53 my $fastgetcwd = fastgetcwd;
54 print +($cwd eq $start ? "" : "not "), "ok 3\n";
55 print +($getcwd eq $start ? "" : "not "), "ok 4\n";
56 print +($fastcwd eq $start ? "" : "not "), "ok 5\n";
57 print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
58 }
59} else {
60 for (3..6) {
61 print "ok $_ # Skip: no pwd command found\n";
62 }
63}
64
1279e177
MS
65mkpath(["_ptrslt_/_path_/_to_/_a_/_dir_"], 0, 0777);
66Cwd::chdir "_ptrslt_/_path_/_to_/_a_/_dir_";
ed4a5f99
BS
67my $cwd = cwd;
68my $getcwd = getcwd;
69my $fastcwd = fastcwd;
70my $fastgetcwd = fastgetcwd;
1279e177 71my $want = "t/_ptrslt_/_path_/_to_/_a_/_dir_";
d39e9359
JH
72print "# cwd = '$cwd'\n";
73print "# getcwd = '$getcwd'\n";
74print "# fastcwd = '$fastcwd'\n";
75print "# fastgetcwd = '$fastgetcwd'\n";
2390ecbc 76# This checked out OK on ODS-2 and ODS-5:
507efa3c 77$want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS';
da3f15f4
JH
78print +($cwd =~ m|$want$| ? "" : "not "), "ok 7\n";
79print +($getcwd =~ m|$want$| ? "" : "not "), "ok 8\n";
80print +($fastcwd =~ m|$want$| ? "" : "not "), "ok 9\n";
81print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
ed4a5f99
BS
82
83# Cwd::chdir should also update $ENV{PWD}
14107c42 84print "#$ENV{PWD}\n";
da3f15f4 85print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
1279e177 86Cwd::chdir "..";
14107c42 87print "#$ENV{PWD}\n";
1279e177 88Cwd::chdir "..";
14107c42 89print "#$ENV{PWD}\n";
1279e177 90Cwd::chdir "..";
14107c42 91print "#$ENV{PWD}\n";
1279e177 92Cwd::chdir "..";
14107c42 93print "#$ENV{PWD}\n";
1279e177 94Cwd::chdir "..";
14107c42 95print "#$ENV{PWD}\n";
1279e177
MS
96
97rmtree(["_ptrslt_"], 0, 0);
98
2390ecbc
PP
99if ($^O eq 'VMS') {
100 # This checked out OK on ODS-2 and ODS-5:
101 print +($ENV{PWD} =~ m|\bT\]$| ? "" : "not "), "ok 12\n";
102}
103else {
104 print +($ENV{PWD} =~ m|\bt$| ? "" : "not "), "ok 12\n";
105}
ed4a5f99 106
d084a483 107if ($Config{d_symlink}) {
1279e177
MS
108 mkpath(["_ptrslt_/_path_/_to_/_a_/_dir_"], 0, 0777);
109 symlink "_ptrslt_/_path_/_to_/_a_/_dir_" => "linktest";
7040f5d5
BS
110
111 my $abs_path = Cwd::abs_path("linktest");
112 my $fast_abs_path = Cwd::fast_abs_path("linktest");
1279e177 113 my $want = "t/_ptrslt_/_path_/_to_/_a_/_dir_";
7040f5d5
BS
114
115 print "# abs_path $abs_path\n";
116 print "# fast_abs_path $fast_abs_path\n";
117 print "# want $want\n";
118 print +($abs_path =~ m|$want$| ? "" : "not "), "ok 13\n";
119 print +($fast_abs_path =~ m|$want$| ? "" : "not "), "ok 14\n";
120
1279e177 121 rmtree(["ptrslt"], 0, 0);
7040f5d5 122 unlink "linktest";
ed4a5f99 123} else {
da3f15f4
JH
124 print "ok 13 # skipped\n";
125 print "ok 14 # skipped\n";
ed4a5f99 126}