This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
avoid runtime module loading in File::Spec
[perl5.git] / dist / PathTools / t / Spec.t
index 150c8d4..643f4a0 100644 (file)
@@ -139,6 +139,7 @@ my @tests = (
 ($] >= 5.008 ? (
 [ "Unix->canonpath(do { my \$x = '///a'.chr(0xaf); use utf8 (); utf8::upgrade(\$x); \$x })",   '/a'.chr(0xaf)   ],
 ) : ()),
+[ "Unix->canonpath(1)",                        '1'              ],
 
 [  "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')",          '.'                  ],
 [  "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')",          '../t4'              ],
@@ -284,7 +285,7 @@ my @tests = (
 [ "Win32->canonpath('/..\\')",          '\\'                  ],
 [ "Win32->canonpath('d1/../foo')",      'foo'                 ],
 
-# FakeWin32 subclass (see below) just sets CWD to C:\one\two and getdcwd('D') to D:\alpha\beta
+# FakeWin32 subclass (see below) just sets getcwd() to C:\one\two and getdcwd('D') to D:\alpha\beta
 
 [ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')",     '.'                      ],
 [ "FakeWin32->abs2rel('/t1/t2/t4','/t1/t2/t3')",     '..\\t4'                 ],
@@ -448,6 +449,13 @@ my @tests = (
 # During the Perl 5.8 era, FS::Unix stopped eliminating redundant path elements, so mimic that here.
 [ "VMS->canonpath('a/../../b/c.dat')",                  $vms_unix_rpt ? 'a/../../b/c.dat'              : '[-.b]c.dat'                      ],
 [ "VMS->canonpath('^<test^.new.-.caret^ escapes^>')",   $vms_unix_rpt ? '/<test.new.-.caret escapes>' : '^<test^.new.-.caret^ escapes^>'                                                   ],
+# Check that directory specs with caret-dot component is treated correctly
+[ "VMS->canonpath('foo:[bar.coo.kie.--]file.txt')",     $vms_unix_rpt ? '/foo/bar/file.txt'            : "foo:[bar]file.txt" ],
+[ "VMS->canonpath('foo:[bar^.coo.kie.--]file.txt')",    $vms_unix_rpt ? '/foo/file.txt'                : "foo:[000000]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo^.kie.--]file.txt')",    $vms_unix_rpt ? '/foo/file.txt'                : "foo:[000000]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo.kie.-]file.txt')",      $vms_unix_rpt ? '/foo/bar/coo/file.txt'        : "foo:[bar.coo]file.txt" ],
+[ "VMS->canonpath('foo:[bar^.coo.kie.-]file.txt')",     $vms_unix_rpt ? '/foo/bar.coo/file.txt'        : "foo:[bar^.coo]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo^.kie.-]file.txt')",     $vms_unix_rpt ? '/foo/bar/file.txt'            : "foo:[bar]file.txt" ],
 
 [ "VMS->splitdir('')",            ''          ],
 [ "VMS->splitdir('[]')",          ''          ],
@@ -790,14 +798,9 @@ my @tests = (
 
 ) ;
 
-can_ok('File::Spec::Win32', '_cwd');
-
 {
     package File::Spec::FakeWin32;
-    use vars qw(@ISA);
-    @ISA = qw(File::Spec::Win32);
-
-    sub _cwd { 'C:\\one\\two' }
+    our @ISA = qw(File::Spec::Win32);
 
     # Some funky stuff to override Cwd::getdcwd() for testing purposes,
     # in the limited scope of the rel2abs() method.
@@ -806,6 +809,8 @@ can_ok('File::Spec::Win32', '_cwd');
        *rel2abs = sub {
            my $self = shift;
            local $^W;
+           local *Cwd::getcwd = sub { 'C:\\one\\two' };
+           *Cwd::getcwd = *Cwd::getcwd; # Avoid a 'used only once' warning
            local *Cwd::getdcwd = sub {
              return 'D:\alpha\beta' if $_[0] eq 'D:';
              return 'C:\one\two'    if $_[0] eq 'C:';
@@ -815,6 +820,14 @@ can_ok('File::Spec::Win32', '_cwd');
            return $self->SUPER::rel2abs(@_);
        };
        *rel2abs = *rel2abs; # Avoid a 'used only once' warning
+       *abs2rel = sub {
+           my $self = shift;
+           local $^W;
+           local *Cwd::getcwd = sub { 'C:\\one\\two' };
+           *Cwd::getcwd = *Cwd::getcwd; # Avoid a 'used only once' warning
+           return $self->SUPER::abs2rel(@_);
+       };
+       *abs2rel = *abs2rel; # Avoid a 'used only once' warning
     }
 }