Commit | Line | Data |
ed4a5f99 |
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; |
1279e177 |
12 | use File::Path; |
ed4a5f99 |
13 | |
da3f15f4 |
14 | print "1..14\n"; |
ed4a5f99 |
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 | |
0d2079fa |
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 | |
da3f15f4 |
31 | # Must find an external pwd (or equivalent) command. |
32 | |
33 | my $pwd_cmd = |
2986a63f |
34 | ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd" } |
da3f15f4 |
35 | split m/$Config{path_sep}/, $ENV{PATH})[0]; |
36 | |
2390ecbc |
37 | if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; } |
38 | |
da3f15f4 |
39 | if (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 |
43 | # DCL SHOW DEFAULT has leading spaces |
44 | $start =~ s/^\s+// if $^O eq 'VMS'; |
da3f15f4 |
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 |
65 | mkpath(["_ptrslt_/_path_/_to_/_a_/_dir_"], 0, 0777); |
66 | Cwd::chdir "_ptrslt_/_path_/_to_/_a_/_dir_"; |
ed4a5f99 |
67 | my $cwd = cwd; |
68 | my $getcwd = getcwd; |
69 | my $fastcwd = fastcwd; |
70 | my $fastgetcwd = fastgetcwd; |
1279e177 |
71 | my $want = "t/_ptrslt_/_path_/_to_/_a_/_dir_"; |
d39e9359 |
72 | print "# cwd = '$cwd'\n"; |
73 | print "# getcwd = '$getcwd'\n"; |
74 | print "# fastcwd = '$fastcwd'\n"; |
75 | print "# 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 |
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"; |
ed4a5f99 |
82 | |
83 | # Cwd::chdir should also update $ENV{PWD} |
14107c42 |
84 | print "#$ENV{PWD}\n"; |
da3f15f4 |
85 | print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n"; |
1279e177 |
86 | Cwd::chdir ".."; |
14107c42 |
87 | print "#$ENV{PWD}\n"; |
1279e177 |
88 | Cwd::chdir ".."; |
14107c42 |
89 | print "#$ENV{PWD}\n"; |
1279e177 |
90 | Cwd::chdir ".."; |
14107c42 |
91 | print "#$ENV{PWD}\n"; |
1279e177 |
92 | Cwd::chdir ".."; |
14107c42 |
93 | print "#$ENV{PWD}\n"; |
1279e177 |
94 | Cwd::chdir ".."; |
14107c42 |
95 | print "#$ENV{PWD}\n"; |
1279e177 |
96 | |
97 | rmtree(["_ptrslt_"], 0, 0); |
98 | |
2390ecbc |
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 | } |
ed4a5f99 |
106 | |
d084a483 |
107 | if ($Config{d_symlink}) { |
1279e177 |
108 | mkpath(["_ptrslt_/_path_/_to_/_a_/_dir_"], 0, 0777); |
109 | symlink "_ptrslt_/_path_/_to_/_a_/_dir_" => "linktest"; |
7040f5d5 |
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 |
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 | |
e9b6bb1c |
121 | rmtree(["_ptrslt_"], 0, 0); |
7040f5d5 |
122 | unlink "linktest"; |
ed4a5f99 |
123 | } else { |
da3f15f4 |
124 | print "ok 13 # skipped\n"; |
125 | print "ok 14 # skipped\n"; |
ed4a5f99 |
126 | } |