Bug #40512 for File-Path: recent breakage on VMS

On Wed Oct 29 20:13:39 2008, CBERRY wrote: Show quoted text
Patch attached against 2.06_07. There is only one change to Path.pm, in the code that checks for "ancestor error." On VMS, you cannot determine that disk:[dir1.dir2] is the parent of disk:[dir1.dir2.dir3] by comparing the two up to the full length of the former because the ']' in the first obviously does not match the '.' in the second. So I subtract one from the comparison length on VMS only. Then I skip the check if the length goes to zero since that's what we'll get if someone passes a one-character dir name like '0' which some of tests do. I'm not sure why you would want to preserve '0' in the list to be passed to _rmtree, but that's what it does and I didn't change it. The other main problem was that a couple of the tests create an empty directory, count the number of files in it by iterating over readdir(), and then fail unless the resulting count is greater than zero. That sort of defies the common sense definition of "empty" and in fact I do get exactly zero files in an empty directory, so the tests were failing. I made them pass by creating one file, but I don't really know if that's right since I don't know what the intent is here. Finally, I skip tests that depend on symlinks when symlinks are not available ($Config[d_symlink} not set).

--- Path.pm;-0 Wed Oct 29 09:39:48 2008 +++ Path.pm Thu Oct 30 07:55:17 2008 @@ -169,7 +169,11 @@ sub rmtree { # need to fixup case and map \ to / on Windows my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p) : $p; my $ortho_cwd = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd}; - if ($ortho_root eq substr($ortho_cwd, 0, length($ortho_root))) { + my $ortho_root_length = length($ortho_root); + $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']' + if ($ortho_root_length + && (substr($ortho_root, 0, $ortho_root_length) + eq substr($ortho_cwd, 0, $ortho_root_length))) { local $! = 0; _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p); next; --- t/path.t;-0 Mon Oct 20 16:36:11 2008 +++ t/path.t Thu Oct 30 07:43:57 2008 @@ -3,6 +3,7 @@ use strict; use Test::More tests => 114; +use Config; BEGIN { use_ok('Cwd'); @@ -97,6 +98,8 @@ sub count { { mkdir 'solo', 0755; chdir 'solo'; + open my $f, '>', 'foo.dat'; + close $f; my $before = count(curdir()); cmp_ok($before, '>', 0, "baseline $before"); @@ -114,6 +117,8 @@ sub count { { mkdir 'solo', 0755; chdir 'solo'; + open my $f, '>', 'foo.dat'; + close $f; my $before = count(curdir()); cmp_ok($before, '>', 0, "ARGV $before"); { @@ -301,6 +306,7 @@ SKIP: { # test bug http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=487319 skip "Don't need Force_Writeable semantics on $^O", 4 if grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2); + skip "Symlinks not available", 4 unless $Config{'d_symlink'}; $dir = 'bug487319'; $dir2 = 'bug487319-symlink'; @created = make_path($dir, {mask => 0700}); @@ -358,6 +364,7 @@ my $extra = catdir(curdir(), qw(EXTRA 1 SKIP: { skip "extra scenarios not set up, see eg/setup-extra-tests", 14 unless -e $extra; + skip "Symlinks not available", 14 unless $Config{'d_symlink'}; my ($list, $err); $dir = catdir( 'EXTRA', '1' );

On Nov 4, 2008, at 6:17 PM, David Landgren via RT wrote: Show quoted text
Thanks, that had the desired effect. There was one new test failure in 2.06_08 that's easily fixed (see attached). We no longer count differently from everybody else when removing a directory in safe mode. Show quoted text