This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
e65336fa3a4ed60041b0595b2055f67ca3722688
[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 use File::Path;
13
14 print "1..14\n";
15
16 # check imports
17 print +(defined(&cwd) && 
18         defined(&getcwd) &&
19         defined(&fastcwd) &&
20         defined(&fastgetcwd) ?
21         "" : "not "), "ok 1\n";
22 print +(!defined(&chdir) &&
23         !defined(&abs_path) &&
24         !defined(&fast_abs_path) ?
25         "" : "not "), "ok 2\n";
26
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
29 eval { fastcwd };
30
31 # Must find an external pwd (or equivalent) command.
32
33 my $pwd_cmd =
34     ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd" }
35                                split m/$Config{path_sep}/, $ENV{PATH})[0];
36
37 if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; }
38
39 if (defined $pwd_cmd) {
40     chomp(my $start = `$pwd_cmd`);
41     # Win32's cd returns native C:\ style
42     $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
43     # DCL SHOW DEFAULT has leading spaces
44     $start =~ s/^\s+// if $^O eq 'VMS';
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
65 mkpath(["_ptrslt_/_path_/_to_/_a_/_dir_"], 0, 0777);
66 Cwd::chdir "_ptrslt_/_path_/_to_/_a_/_dir_";
67 my $cwd        = cwd;
68 my $getcwd     = getcwd;
69 my $fastcwd    = fastcwd;
70 my $fastgetcwd = fastgetcwd;
71 my $want = "t/_ptrslt_/_path_/_to_/_a_/_dir_";
72 print "# cwd        = '$cwd'\n";
73 print "# getcwd     = '$getcwd'\n";
74 print "# fastcwd    = '$fastcwd'\n";
75 print "# fastgetcwd = '$fastgetcwd'\n";
76 # This checked out OK on ODS-2 and ODS-5:
77 $want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS';
78 print +($cwd        =~ m|$want$| ? "" : "not "), "ok 7\n";
79 print +($getcwd     =~ m|$want$| ? "" : "not "), "ok 8\n";
80 print +($fastcwd    =~ m|$want$| ? "" : "not "), "ok 9\n";
81 print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
82
83 # Cwd::chdir should also update $ENV{PWD}
84 print "#$ENV{PWD}\n";
85 print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
86 Cwd::chdir "..";
87 print "#$ENV{PWD}\n";
88 Cwd::chdir "..";
89 print "#$ENV{PWD}\n";
90 Cwd::chdir "..";
91 print "#$ENV{PWD}\n";
92 Cwd::chdir "..";
93 print "#$ENV{PWD}\n";
94 Cwd::chdir "..";
95 print "#$ENV{PWD}\n";
96
97 rmtree(["_ptrslt_"], 0, 0);
98
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     mkpath(["_ptrslt_/_path_/_to_/_a_/_dir_"], 0, 0777);
109     symlink "_ptrslt_/_path_/_to_/_a_/_dir_" => "linktest";
110
111     my $abs_path      =  Cwd::abs_path("linktest");
112     my $fast_abs_path =  Cwd::fast_abs_path("linktest");
113     my $want          = "t/_ptrslt_/_path_/_to_/_a_/_dir_";
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
121     rmtree(["_ptrslt_"], 0, 0);
122     unlink "linktest";
123 } else {
124     print "ok 13 # skipped\n";
125     print "ok 14 # skipped\n";
126 }