r71158 - in /trunk/libfile-remove-perl: Changes MANIFEST META.yml debian/changelog debian/source/local-options lib/File/Remove.pm t/02_directories.t t/03_deep_readonly.t t/04_can_delete.t t/05_links.t t/07_cwd.t t/08_spaces.t xt/pmv.t
ansgar at users.alioth.debian.org
ansgar at users.alioth.debian.org
Fri Mar 11 13:28:21 UTC 2011
Author: ansgar
Date: Fri Mar 11 13:28:08 2011
New Revision: 71158
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71158
Log:
* Team upload.
* New upstream release.
Added:
trunk/libfile-remove-perl/debian/source/local-options
trunk/libfile-remove-perl/t/08_spaces.t
- copied unchanged from r71157, branches/upstream/libfile-remove-perl/current/t/08_spaces.t
Modified:
trunk/libfile-remove-perl/Changes
trunk/libfile-remove-perl/MANIFEST
trunk/libfile-remove-perl/META.yml
trunk/libfile-remove-perl/debian/changelog
trunk/libfile-remove-perl/lib/File/Remove.pm
trunk/libfile-remove-perl/t/02_directories.t
trunk/libfile-remove-perl/t/03_deep_readonly.t
trunk/libfile-remove-perl/t/04_can_delete.t
trunk/libfile-remove-perl/t/05_links.t
trunk/libfile-remove-perl/t/07_cwd.t
trunk/libfile-remove-perl/xt/pmv.t
Modified: trunk/libfile-remove-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/Changes?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/Changes (original)
+++ trunk/libfile-remove-perl/Changes Fri Mar 11 13:28:08 2011
@@ -1,4 +1,13 @@
Revision history for Perl extension File-Remove
+
+1.48 Fri 11 Mar 2011 - Adam Kennedy
+ - Promoting dev code to production version
+ - Fixed a major bug in the 1.46 logic that works out what to change the
+ cwd to when deleting while inside a directory.
+
+1.47_01 Fri 18 Feb 2011 - Adam Kennedy
+ - Add test counts to all test scripts
+ - Added a test for space-safe globs
1.46 Fri 18 Feb 2011 - Adam Kennedy
- No changes from 1.45_01
Modified: trunk/libfile-remove-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/MANIFEST?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/MANIFEST (original)
+++ trunk/libfile-remove-perl/MANIFEST Fri Mar 11 13:28:08 2011
@@ -21,6 +21,7 @@
t/05_links.t
t/06_curly.t
t/07_cwd.t
+t/08_spaces.t
xt/meta.t
xt/pmv.t
xt/pod.t
Modified: trunk/libfile-remove-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/META.yml?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/META.yml (original)
+++ trunk/libfile-remove-perl/META.yml Fri Mar 11 13:28:08 2011
@@ -28,4 +28,4 @@
ChangeLog: http://fisheye2.atlassian.com/changelog/cpan/trunk/File-Remove
license: http://dev.perl.org/licenses/
repository: http://svn.ali.as/cpan/trunk/File-Remove
-version: 1.46
+version: 1.48
Modified: trunk/libfile-remove-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/debian/changelog?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/debian/changelog (original)
+++ trunk/libfile-remove-perl/debian/changelog Fri Mar 11 13:28:08 2011
@@ -1,3 +1,10 @@
+libfile-remove-perl (1.48-1) unstable; urgency=low
+
+ * Team upload.
+ * New upstream release.
+
+ -- Ansgar Burchardt <ansgar at debian.org> Fri, 11 Mar 2011 14:27:55 +0100
+
libfile-remove-perl (1.46-1) unstable; urgency=low
[ Salvatore Bonaccorso ]
Added: trunk/libfile-remove-perl/debian/source/local-options
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/debian/source/local-options?rev=71158&op=file
==============================================================================
--- trunk/libfile-remove-perl/debian/source/local-options (added)
+++ trunk/libfile-remove-perl/debian/source/local-options Fri Mar 11 13:28:08 2011
@@ -1,0 +1,2 @@
+abort-on-upstream-changes
+unapply-patches
Modified: trunk/libfile-remove-perl/lib/File/Remove.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/lib/File/Remove.pm?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/lib/File/Remove.pm (original)
+++ trunk/libfile-remove-perl/lib/File/Remove.pm Fri Mar 11 13:28:08 2011
@@ -6,7 +6,8 @@
use vars qw{ $VERSION @ISA @EXPORT_OK };
use vars qw{ $DEBUG $unlink $rmdir };
BEGIN {
- $VERSION = '1.46';
+ $VERSION = '1.48';
+ # $VERSION = eval $VERSION;
@ISA = qw{ Exporter };
@EXPORT_OK = qw{ remove rm clear trash };
}
@@ -225,9 +226,12 @@
# Do we need to move to a different directory to delete a directory,
# and if so which.
sub _moveto {
+ my $remove = File::Spec->rel2abs(shift);
+ my $cwd = @_ ? shift : Cwd::cwd();
+
# Do everything in absolute terms
- my $cwd = Cwd::abs_path( Cwd::cwd() );
- my $remove = Cwd::abs_path( File::Spec->rel2abs(shift) );
+ $remove = Cwd::abs_path( $remove );
+ $cwd = Cwd::abs_path( $cwd );
# If we are on a different volume we don't need to move
my ( $cv, $cd ) = File::Spec->splitpath( $cwd, 1 );
@@ -237,10 +241,9 @@
# If we have to move, it's to one level above the deletion
my @cd = File::Spec->splitdir($cd);
my @rd = File::Spec->splitdir($rd);
- pop @rd;
-
- # Is the current directory inside of the moveto directory?
- unless ( @cd > @rd ) {
+
+ # Is the current directory the same as or inside the remove directory?
+ unless ( @cd >= @rd ) {
return '';
}
foreach ( 0 .. $#rd ) {
@@ -248,6 +251,7 @@
}
# Confirmed, the current working dir is in the removal dir
+ pop @rd;
return File::Spec->catpath(
$rv,
File::Spec->catdir(@rd),
Modified: trunk/libfile-remove-perl/t/02_directories.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/t/02_directories.t?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/t/02_directories.t (original)
+++ trunk/libfile-remove-perl/t/02_directories.t Fri Mar 11 13:28:08 2011
@@ -6,7 +6,7 @@
$^W = 1;
}
-use Test::More qw(no_plan); # tests => 2;
+use Test::More tests => 152;
use File::Remove qw{ remove trash };
@@ -147,5 +147,3 @@
UNDELETE: 1;
}
-
-1;
Modified: trunk/libfile-remove-perl/t/03_deep_readonly.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/t/03_deep_readonly.t?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/t/03_deep_readonly.t (original)
+++ trunk/libfile-remove-perl/t/03_deep_readonly.t Fri Mar 11 13:28:08 2011
@@ -8,7 +8,7 @@
$^W = 1;
}
-use Test::More qw(no_plan);
+use Test::More tests => 12;
use File::Spec::Functions ':ALL';
use File::Copy ();
use File::Remove ();
Modified: trunk/libfile-remove-perl/t/04_can_delete.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/t/04_can_delete.t?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/t/04_can_delete.t (original)
+++ trunk/libfile-remove-perl/t/04_can_delete.t Fri Mar 11 13:28:08 2011
@@ -8,7 +8,7 @@
$^W = 1;
}
-use Test::More qw(no_plan);
+use Test::More tests => 12;
use File::Spec::Functions ':ALL';
use File::Copy ();
use File::Remove ();
@@ -40,12 +40,12 @@
chmod( 0400, $f3 );
ok( -f $f3, "Created $f3 ok" );
ok( -r $f3, "Created $f3 -r" );
- SKIP: {
- if ( $^O ne 'MSWin32' and $< == 0 ) {
- skip("This test doesn't work as root", 1);
- }
- ok( ! -w $f3, "Created $f3 ! -w" );
- };
+ SKIP: {
+ if ( $^O ne 'MSWin32' and $< == 0 ) {
+ skip("This test doesn't work as root", 1);
+ }
+ ok( ! -w $f3, "Created $f3 ! -w" );
+ };
}
sub clear_directory {
Modified: trunk/libfile-remove-perl/t/05_links.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/t/05_links.t?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/t/05_links.t (original)
+++ trunk/libfile-remove-perl/t/05_links.t Fri Mar 11 13:28:08 2011
@@ -62,5 +62,3 @@
ok( File::Remove::remove(\1, $testdir), "remove \\1: $testdir" );
ok( ! -e $testdir, "!-e: $testdir" );
-
-1;
Modified: trunk/libfile-remove-perl/t/07_cwd.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/t/07_cwd.t?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/t/07_cwd.t (original)
+++ trunk/libfile-remove-perl/t/07_cwd.t Fri Mar 11 13:28:08 2011
@@ -6,7 +6,7 @@
$^W = 1;
}
-use Test::More tests => 9;
+use Test::More tests => 13;
use File::Spec::Functions ':ALL';
use File::Remove ();
use Cwd ();
@@ -25,6 +25,46 @@
ok( -d $cwd, "$cwd directory exists" );
ok( -d $foo, "$foo directory exists" );
ok( -f $file, "$file file exists" );
+
+# Test that _moveto behaves as expected
+SCOPE: {
+ is(
+ File::Remove::_moveto(
+ File::Spec->catdir($base, 't'), # remove
+ File::Spec->catdir($base), # cwd
+ ),
+ '',
+ '_moveto returns correct for normal case',
+ );
+
+ my $moveto1 = File::Remove::_moveto(
+ File::Spec->catdir($base, 't'), # remove
+ File::Spec->catdir($base, 't'), # cwd
+ );
+ $moveto1 =~ s/\\/\//g;
+ is( $moveto1, $base, '_moveto returns correct for normal case' );
+
+ my $moveto2 = File::Remove::_moveto(
+ File::Spec->catdir($base, 't'), # remove
+ File::Spec->catdir($base, 't', 'cwd'), # cwd
+ );
+ $moveto2 =~ s/\\/\//g;
+ is( $moveto2, $base, '_moveto returns correct for normal case' );
+
+ # Regression: _moveto generates false positives
+ # cwd: /tmp/cpan2/PITA-Image/PITA-Image-0.50
+ # remove: /tmp/eBtQxTPGHC
+ # moveto: /tmp
+ # expected: ''
+ is(
+ File::Remove::_moveto(
+ File::Spec->catdir($base, 't'), # remove
+ File::Spec->catdir($base, 'lib', 'File'), # cwd
+ ),
+ '',
+ '_moveto returns null as expected',
+ );
+}
# Change the current working directory into the first
# test directory and store the absolute path.
Modified: trunk/libfile-remove-perl/xt/pmv.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-remove-perl/xt/pmv.t?rev=71158&op=diff
==============================================================================
--- trunk/libfile-remove-perl/xt/pmv.t (original)
+++ trunk/libfile-remove-perl/xt/pmv.t Fri Mar 11 13:28:08 2011
@@ -9,7 +9,7 @@
}
my @MODULES = (
- 'Perl::MinimumVersion 1.25',
+ 'Perl::MinimumVersion 1.27',
'Test::MinimumVersion 0.101080',
);
More information about the Pkg-perl-cvs-commits
mailing list