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 0255bdb..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'                 ],
@@ -797,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.
@@ -813,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:';
@@ -822,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
     }
 }