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; |
12 | |
da3f15f4 |
13 | print "1..14\n"; |
ed4a5f99 |
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 | |
0d2079fa |
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 | |
da3f15f4 |
30 | # Must find an external pwd (or equivalent) command. |
31 | |
32 | my $pwd_cmd = |
14107c42 |
33 | ($^O eq "MSWin32") ? "cd" : (grep { -x && -f } map { "$_/pwd" } |
da3f15f4 |
34 | split m/$Config{path_sep}/, $ENV{PATH})[0]; |
35 | |
2390ecbc |
36 | if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; } |
37 | |
da3f15f4 |
38 | if (defined $pwd_cmd) { |
39 | chomp(my $start = `$pwd_cmd`); |
14107c42 |
40 | # Win32's cd returns native C:\ style |
41 | $start =~ s,\\,/,g if $^O eq 'MSWin32'; |
2390ecbc |
42 | # DCL SHOW DEFAULT has leading spaces |
43 | $start =~ s/^\s+// if $^O eq 'VMS'; |
da3f15f4 |
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 | |
ed4a5f99 |
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"; |
d39e9359 |
75 | print "# cwd = '$cwd'\n"; |
76 | print "# getcwd = '$getcwd'\n"; |
77 | print "# fastcwd = '$fastcwd'\n"; |
78 | print "# fastgetcwd = '$fastgetcwd'\n"; |
2390ecbc |
79 | # This checked out OK on ODS-2 and ODS-5: |
507efa3c |
80 | $want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS'; |
da3f15f4 |
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"; |
ed4a5f99 |
85 | |
86 | # Cwd::chdir should also update $ENV{PWD} |
14107c42 |
87 | print "#$ENV{PWD}\n"; |
da3f15f4 |
88 | print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n"; |
ed4a5f99 |
89 | Cwd::chdir ".."; rmdir "dir"; |
14107c42 |
90 | print "#$ENV{PWD}\n"; |
ed4a5f99 |
91 | Cwd::chdir ".."; rmdir "a"; |
14107c42 |
92 | print "#$ENV{PWD}\n"; |
ed4a5f99 |
93 | Cwd::chdir ".."; rmdir "to"; |
14107c42 |
94 | print "#$ENV{PWD}\n"; |
ed4a5f99 |
95 | Cwd::chdir ".."; rmdir "path"; |
14107c42 |
96 | print "#$ENV{PWD}\n"; |
ed4a5f99 |
97 | Cwd::chdir ".."; rmdir "pteerslt"; |
14107c42 |
98 | print "#$ENV{PWD}\n"; |
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}) { |
108 | my @dirs = grep(! -l $_ => (split " " => $Config{libpth})); |
109 | if (@dirs) { |
110 | my $target = pop @dirs; |
111 | symlink $target => "linktest"; |
112 | mkdir "pteerslt"; |
113 | chdir "pteerslt"; |
114 | my $rel = "../../t/linktest"; |
115 | |
116 | my $abs_path = Cwd::abs_path($rel); |
117 | my $fast_abs_path = Cwd::fast_abs_path($rel); |
118 | print "# abs_path $abs_path\n"; |
119 | print "# fast_abs_path $fast_abs_path\n"; |
120 | print "# target $target\n"; |
121 | print +($abs_path eq $target ? "" : "not "), "ok 13\n"; |
122 | print +($fast_abs_path eq $target ? "" : "not "), "ok 14\n"; |
123 | |
124 | chdir ".."; |
125 | rmdir "pteerslt"; |
126 | unlink "linktest"; |
127 | } else { |
128 | print "ok 13 # skipped\n"; |
129 | print "ok 14 # skipped\n"; |
130 | } |
ed4a5f99 |
131 | } else { |
da3f15f4 |
132 | print "ok 13 # skipped\n"; |
133 | print "ok 14 # skipped\n"; |
ed4a5f99 |
134 | } |