1use warnings; 2use strict; 3 4use Config; 5use Errno qw(); 6use File::Temp qw(tempdir); 7use Test::More; 8 9if($^O eq "cygwin") { 10 # This test skipping should be removed when the Cygwin bug is fixed. 11 plan skip_all => "getcwd() fails to fail on Cygwin [perl #132733]"; 12} 13 14my $tmp = tempdir(CLEANUP => 1); 15unless(mkdir("$tmp/testdir") && chdir("$tmp/testdir") && rmdir("$tmp/testdir")){ 16 plan skip_all => "can't be in non-existent directory"; 17} 18 19plan tests => 8; 20require Cwd; 21 22my @acceptable_errnos = (&Errno::ENOENT, (defined &Errno::ESTALE ? &Errno::ESTALE : ())); 23foreach my $type (qw(regular perl)) { 24 SKIP: { 25 skip "_perl_abs_path() not expected to work", 4 26 if $type eq "perl" && 27 !(($Config{prefix} =~ m/\//) && $^O ne "cygwin"); 28 29 # https://github.com/Perl/perl5/issues/16525 30 # https://bugs.dragonflybsd.org/issues/3250 31 my @vlist = ($Config{osvers} =~ /(\d+)/g); 32 my $osver = sprintf("%d%03d", map { defined() ? $_ : '0' } @vlist[0,1]); 33 skip "getcwd() doesn't fail on non-existent directories on this platform", 4 34 if $type eq 'regular' && $^O eq 'dragonfly' && $osver < 6002; 35 36 skip "getcwd() doesn't fail on non-existent directories on this platform", 4 37 if $type eq 'regular' && $^O eq 'haiku'; 38 39 no warnings "redefine"; 40 local *Cwd::abs_path = \&Cwd::_perl_abs_path if $type eq "perl"; 41 local *Cwd::getcwd = \&Cwd::_perl_getcwd if $type eq "perl"; 42 my($res, $eno); 43 $! = 0; 44 $res = Cwd::getcwd(); 45 $eno = 0+$!; 46 is $res, undef, "$type getcwd result on non-existent directory"; 47 ok((grep { $eno == $_ } @acceptable_errnos), "$type getcwd errno on non-existent directory") 48 or diag "Got errno code $eno, expected " . join(", ", @acceptable_errnos); 49 $! = 0; 50 $res = Cwd::abs_path("."); 51 $eno = 0+$!; 52 is $res, undef, "$type abs_path result on non-existent directory"; 53 ok((grep { $eno == $_ } @acceptable_errnos), "$type abs_path errno on non-existent directory") 54 or diag "Got errno code $eno, expected " . join(", ", @acceptable_errnos); 55 } 56} 57 58chdir $tmp or die "$tmp: $!"; 59 60END { chdir $tmp; } 61 621; 63