This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
09b45d600488e531543d506672cc7245e9a4d1de
[perl5.git] / ext / Cwd / t / cwd.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 use Config;
9 use Cwd;
10 use strict;
11 use warnings;
12
13 print "1..14\n";
14
15 # check imports
16 print +(defined(&cwd) && 
17         defined(&getcwd) &&
18         defined(&fastcwd) &&
19         defined(&fastgetcwd) ?
20         "" : "not "), "ok 1\n";
21 print +(!defined(&chdir) &&
22         !defined(&abs_path) &&
23         !defined(&fast_abs_path) ?
24         "" : "not "), "ok 2\n";
25
26 # XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
27 # XXX and subsequent chdir()s can make them impossible to find
28 eval { fastcwd };
29
30 # Must find an external pwd (or equivalent) command.
31
32 my $pwd_cmd =
33     ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd" }
34                                split m/$Config{path_sep}/, $ENV{PATH})[0];
35
36 if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; }
37
38 if (defined $pwd_cmd) {
39     chomp(my $start = `$pwd_cmd`);
40     # Win32's cd returns native C:\ style
41     $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
42     # DCL SHOW DEFAULT has leading spaces
43     $start =~ s/^\s+// if $^O eq 'VMS';
44     if ($?) {
45         for (3..6) {
46             print "ok $_ # Skip: '$pwd_cmd' failed\n";
47         }
48     } else {
49         my $cwd        = cwd;
50         my $getcwd     = getcwd;
51         my $fastcwd    = fastcwd;
52         my $fastgetcwd = fastgetcwd;
53         print +($cwd        eq $start ? "" : "not "), "ok 3\n";
54         print +($getcwd     eq $start ? "" : "not "), "ok 4\n";
55         print +($fastcwd    eq $start ? "" : "not "), "ok 5\n";
56         print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
57     }
58 } else {
59     for (3..6) {
60         print "ok $_ # Skip: no pwd command found\n";
61     }
62 }
63
64 mkdir "pteerslt", 0777;
65 mkdir "pteerslt/path", 0777;
66 mkdir "pteerslt/path/to", 0777;
67 mkdir "pteerslt/path/to/a", 0777;
68 mkdir "pteerslt/path/to/a/dir", 0777;
69 Cwd::chdir "pteerslt/path/to/a/dir";
70 my $cwd        = cwd;
71 my $getcwd     = getcwd;
72 my $fastcwd    = fastcwd;
73 my $fastgetcwd = fastgetcwd;
74 my $want = "t/pteerslt/path/to/a/dir";
75 print "# cwd        = '$cwd'\n";
76 print "# getcwd     = '$getcwd'\n";
77 print "# fastcwd    = '$fastcwd'\n";
78 print "# fastgetcwd = '$fastgetcwd'\n";
79 # This checked out OK on ODS-2 and ODS-5:
80 $want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS';
81 print +($cwd        =~ m|$want$| ? "" : "not "), "ok 7\n";
82 print +($getcwd     =~ m|$want$| ? "" : "not "), "ok 8\n";
83 print +($fastcwd    =~ m|$want$| ? "" : "not "), "ok 9\n";
84 print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
85
86 # Cwd::chdir should also update $ENV{PWD}
87 print "#$ENV{PWD}\n";
88 print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
89 Cwd::chdir ".."; rmdir "dir";
90 print "#$ENV{PWD}\n";
91 Cwd::chdir ".."; rmdir "a";
92 print "#$ENV{PWD}\n";
93 Cwd::chdir ".."; rmdir "to";
94 print "#$ENV{PWD}\n";
95 Cwd::chdir ".."; rmdir "path";
96 print "#$ENV{PWD}\n";
97 Cwd::chdir ".."; rmdir "pteerslt";
98 print "#$ENV{PWD}\n";
99 if ($^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 }
103 else {
104     print +($ENV{PWD}  =~ m|\bt$| ? "" : "not "), "ok 12\n";
105 }
106
107 if ($Config{d_symlink}) {
108     mkdir "pteerslt", 0777;
109     mkdir "pteerslt/path", 0777;
110     mkdir "pteerslt/path/to", 0777;
111     mkdir "pteerslt/path/to/a", 0777;
112     mkdir "pteerslt/path/to/a/dir", 0777;
113     symlink "pteerslt/path/to/a/dir" => "linktest";
114
115     my $abs_path      =  Cwd::abs_path("linktest");
116     my $fast_abs_path =  Cwd::fast_abs_path("linktest");
117     my $want          = "t/pteerslt/path/to/a/dir";
118
119     print "# abs_path      $abs_path\n";
120     print "# fast_abs_path $fast_abs_path\n";
121     print "# want          $want\n";
122     print +($abs_path      =~ m|$want$| ? "" : "not "), "ok 13\n";
123     print +($fast_abs_path =~ m|$want$| ? "" : "not "), "ok 14\n";
124
125     rmdir "pteerslt/path/to/a/dir";
126     rmdir "pteerslt/path/to/a";
127     rmdir "pteerslt/path/to";
128     rmdir "pteerslt/path";
129     rmdir "pteerslt";
130     unlink "linktest";
131 } else {
132     print "ok 13 # skipped\n";
133     print "ok 14 # skipped\n";
134 }