summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSalvatore Bonaccorso <carnil@debian.org>2020-10-25 09:40:51 +0100
committerSalvatore Bonaccorso <carnil@debian.org>2020-10-25 09:40:51 +0100
commitb80cd44c2e1ad5b0adcf34da327350bb5deb05ac (patch)
treee6d10717637981b3eb26e71287f007666c105d20
parentb264d1d76c951c0e86a615d744596c2c9426c403 (diff)
New upstream version 1.60
-rw-r--r--Build.PL10
-rw-r--r--Changes7
-rw-r--r--MANIFEST1
-rw-r--r--META.json17
-rw-r--r--META.yml13
-rw-r--r--Makefile.PL6
-rw-r--r--README2
-rw-r--r--dist.ini3
-rw-r--r--lib/File/Remove.pm217
-rwxr-xr-xt/01_compile.t8
-rwxr-xr-xt/02_directories.t182
-rwxr-xr-xt/03_deep_readonly.t92
-rw-r--r--t/04_can_delete.t94
-rw-r--r--t/05_links.t47
-rw-r--r--t/06_curly.t35
-rw-r--r--t/07_cwd.t82
-rw-r--r--t/08_spaces.t81
-rw-r--r--t/09_fork.t34
-rw-r--r--t/10_noglob.t29
-rw-r--r--xt/author/tidyall.t11
20 files changed, 591 insertions, 380 deletions
diff --git a/Build.PL b/Build.PL
index 5fd134d..5307072 100644
--- a/Build.PL
+++ b/Build.PL
@@ -19,7 +19,7 @@ my %module_build_args = (
"Shlomi Fish <shlomif\@cpan.org>"
],
"dist_name" => "File-Remove",
- "dist_version" => "1.59",
+ "dist_version" => "1.60",
"license" => "perl",
"module_name" => "File::Remove",
"recursive_test_files" => 1,
@@ -29,7 +29,7 @@ my %module_build_args = (
"File::Path" => 0,
"File::Spec" => "3.29",
"constant" => 0,
- "perl" => "5.006",
+ "perl" => "5.008",
"strict" => 0,
"vars" => 0,
"warnings" => 0
@@ -40,8 +40,7 @@ my %module_build_args = (
"File::Spec::Functions" => 0,
"IO::Handle" => 0,
"IPC::Open3" => 0,
- "Test::More" => "0.88",
- "perl" => "5.006"
+ "Test::More" => "0.88"
}
);
@@ -53,8 +52,7 @@ my %fallback_build_requires = (
"IO::Handle" => 0,
"IPC::Open3" => 0,
"Module::Build" => "0.28",
- "Test::More" => "0.88",
- "perl" => "5.006"
+ "Test::More" => "0.88"
);
diff --git a/Changes b/Changes
index 7cfd5b4..4ebcc2e 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,12 @@
Revision history for Perl extension File-Remove
+1.60 2020-10-22 - Shlomi Fish
+ - Add .tidyallrc + related changes
+ - Fix mismatched $VERSION.
+ - https://rt.cpan.org/Public/Bug/Display.html?id=133562
+ - https://github.com/shlomif/File-Remove/pull/3/files
+ - Thanks to William Storey, PMPERRY, and @briang for the report
+
1.59 2020-10-16 - Shlomi Fish
- dist.ini / weaver.ini / .tidyallrc / etc. cleanup
- Move to @SHLOMIF
diff --git a/MANIFEST b/MANIFEST
index e56b193..628197f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -26,5 +26,6 @@ xt/author/eol.t
xt/author/no-tabs.t
xt/author/pod-coverage.t
xt/author/pod-syntax.t
+xt/author/tidyall.t
xt/release/cpan-changes.t
xt/release/trailing-space.t
diff --git a/META.json b/META.json
index c75876e..1eb4656 100644
--- a/META.json
+++ b/META.json
@@ -29,6 +29,7 @@
"requires" : {
"Pod::Coverage::TrustPod" : "0",
"Test::CPAN::Changes" : "0.19",
+ "Test::Code::TidyAll" : "0.50",
"Test::EOL" : "0",
"Test::More" : "0.96",
"Test::NoTabs" : "0",
@@ -44,7 +45,7 @@
"File::Path" : "0",
"File::Spec" : "3.29",
"constant" : "0",
- "perl" : "5.006",
+ "perl" : "5.008",
"strict" : "0",
"vars" : "0",
"warnings" : "0"
@@ -57,15 +58,14 @@
"File::Spec::Functions" : "0",
"IO::Handle" : "0",
"IPC::Open3" : "0",
- "Test::More" : "0.88",
- "perl" : "5.006"
+ "Test::More" : "0.88"
}
}
},
"provides" : {
"File::Remove" : {
"file" : "lib/File/Remove.pm",
- "version" : "1.59"
+ "version" : "1.60"
}
},
"release_status" : "stable",
@@ -81,7 +81,7 @@
"web" : "https://github.com/shlomif/File-Remove"
}
},
- "version" : "1.59",
+ "version" : "1.60",
"x_Dist_Zilla" : {
"perl" : {
"version" : "5.032000"
@@ -318,7 +318,7 @@
{
"class" : "Dist::Zilla::Plugin::Test::TrailingSpace",
"name" : "@Filter/Test::TrailingSpace",
- "version" : "0.2.0"
+ "version" : null
},
{
"class" : "Dist::Zilla::Plugin::TestRelease",
@@ -471,6 +471,11 @@
"version" : "6.015"
},
{
+ "class" : "Dist::Zilla::Plugin::Test::TidyAll",
+ "name" : "Test::TidyAll",
+ "version" : "0.04"
+ },
+ {
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":InstallModules",
"version" : "6.015"
diff --git a/META.yml b/META.yml
index c34431f..cadf09b 100644
--- a/META.yml
+++ b/META.yml
@@ -10,7 +10,6 @@ build_requires:
IPC::Open3: '0'
Module::Build: '0.28'
Test::More: '0.88'
- perl: '5.006'
configure_requires:
ExtUtils::MakeMaker: '0'
Module::Build: '0.28'
@@ -24,14 +23,14 @@ name: File-Remove
provides:
File::Remove:
file: lib/File/Remove.pm
- version: '1.59'
+ version: '1.60'
requires:
Cwd: '3.29'
File::Glob: '0'
File::Path: '0'
File::Spec: '3.29'
constant: '0'
- perl: '5.006'
+ perl: '5.008'
strict: '0'
vars: '0'
warnings: '0'
@@ -39,7 +38,7 @@ resources:
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Remove
homepage: http://metacpan.org/release/File-Remove
repository: git://github.com/shlomif/File-Remove.git
-version: '1.59'
+version: '1.60'
x_Dist_Zilla:
perl:
version: '5.032000'
@@ -221,7 +220,7 @@ x_Dist_Zilla:
-
class: Dist::Zilla::Plugin::Test::TrailingSpace
name: '@Filter/Test::TrailingSpace'
- version: 0.2.0
+ version: ~
-
class: Dist::Zilla::Plugin::TestRelease
name: '@Filter/TestRelease'
@@ -341,6 +340,10 @@ x_Dist_Zilla:
name: '@Filter/UploadToCPAN'
version: '6.015'
-
+ class: Dist::Zilla::Plugin::Test::TidyAll
+ name: Test::TidyAll
+ version: '0.04'
+ -
class: Dist::Zilla::Plugin::FinderCode
name: ':InstallModules'
version: '6.015'
diff --git a/Makefile.PL b/Makefile.PL
index f85f1f8..45071fe 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use 5.006;
+use 5.008;
use ExtUtils::MakeMaker;
@@ -18,7 +18,7 @@ my %WriteMakefileArgs = (
},
"DISTNAME" => "File-Remove",
"LICENSE" => "perl",
- "MIN_PERL_VERSION" => "5.006",
+ "MIN_PERL_VERSION" => "5.008",
"NAME" => "File::Remove",
"PREREQ_PM" => {
"Cwd" => "3.29",
@@ -38,7 +38,7 @@ my %WriteMakefileArgs = (
"IPC::Open3" => 0,
"Test::More" => "0.88"
},
- "VERSION" => "1.59",
+ "VERSION" => "1.60",
"test" => {
"TESTS" => "t/*.t"
}
diff --git a/README b/README
index a4ed52a..816f342 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
This archive contains the distribution File-Remove,
-version 1.59:
+version 1.60:
Remove files and directories
diff --git a/dist.ini b/dist.ini
index 65aae25..2aa08a9 100644
--- a/dist.ini
+++ b/dist.ini
@@ -3,7 +3,7 @@ author = Shlomi Fish <shlomif@cpan.org>
license = Perl_5
copyright_holder = Gabor Egressy
copyright_year = 1998
-version = 1.59
+version = 1.60
[@Filter]
-bundle = @SHLOMIF
@@ -14,3 +14,4 @@ bugtracker_mailto = bug-file-remove@rt.cpan.org
repository_url = git://github.com/shlomif/File-Remove.git
repository_web = https://github.com/shlomif/File-Remove
repository_type = git
+[Test::TidyAll]
diff --git a/lib/File/Remove.pm b/lib/File/Remove.pm
index 10223a8..cb732a0 100644
--- a/lib/File/Remove.pm
+++ b/lib/File/Remove.pm
@@ -1,16 +1,14 @@
package File::Remove;
-
-use 5.00503;
+$File::Remove::VERSION = '1.60';
+use 5.008;
use strict;
use warnings;
use vars qw{ @ISA @EXPORT_OK };
use vars qw{ $DEBUG $unlink $rmdir };
-our $VERSION = '1.58';
-
-BEGIN {
- # $VERSION = eval $VERSION;
+BEGIN
+{
@ISA = qw{ Exporter };
@EXPORT_OK = qw{ remove rm clear trash };
}
@@ -18,41 +16,40 @@ BEGIN {
use File::Path ();
use File::Glob ();
use File::Spec 3.29 ();
-use Cwd 3.29 ();
+use Cwd 3.29 ();
# $debug variable must be set before loading File::Remove.
# Convert to a constant to allow debugging code to be pruned out.
-use constant DEBUG => !! $DEBUG;
+use constant DEBUG => !!$DEBUG;
# Are we on VMS?
# If so copy File::Path and assume VMS::Filespec is loaded
-use constant IS_VMS => !! ( $^O eq 'VMS' );
+use constant IS_VMS => !!( $^O eq 'VMS' );
# Are we on Mac?
# If so we'll need to do some special trash work
-use constant IS_MAC => !! ( $^O eq 'darwin' );
+use constant IS_MAC => !!( $^O eq 'darwin' );
# Are we on Win32?
# If so write permissions does not imply deletion permissions
-use constant IS_WIN32 => !! ( $^O =~ /^MSWin/ or $^O eq 'cygwin' );
+use constant IS_WIN32 => !!( $^O =~ /^MSWin/ or $^O eq 'cygwin' );
# If we ever need a Mac::Glue object we will want to cache it.
my $glue;
-
-
-
-
#####################################################################
# Main Functions
my @CLEANUP = ();
-sub clear (@) {
- my @files = expand( @_ );
+## no critic
+sub clear (@)
+{
+ my @files = expand(@_);
# Do the initial deletion
- foreach my $file ( @files ) {
+ foreach my $file (@files)
+ {
next unless -e $file;
remove( \1, $file );
}
@@ -63,9 +60,12 @@ sub clear (@) {
# live until their end-time.
push @CLEANUP, map { [ $$, $_ ] } @files;
}
+## use critic
-END {
- foreach my $file ( @CLEANUP ) {
+END
+{
+ foreach my $file (@CLEANUP)
+ {
next unless $file->[0] == $$;
next unless -e $file->[1];
remove( \1, $file->[1] );
@@ -75,96 +75,129 @@ END {
# Acts like unlink would until given a directory as an argument, then
# it acts like rm -rf ;) unless the recursive arg is zero which it is by
# default
-sub remove (@) {
- my $recursive = (ref $_[0] eq 'SCALAR') ? shift : \0;
- my $opts = (ref $_[0] eq 'HASH') ? shift : { glob => 1 };
- my @files = _expand_with_opts ($opts, @_);
+## no critic
+sub remove (@)
+{
+ ## use critic
+ my $recursive = ( ref $_[0] eq 'SCALAR' ) ? shift : \0;
+ my $opts = ( ref $_[0] eq 'HASH' ) ? shift : { glob => 1 };
+ my @files = _expand_with_opts( $opts, @_ );
# Iterate over the files
my @removes;
- foreach my $path ( @files ) {
+ foreach my $path (@files)
+ {
# need to check for symlink first
# could be pointing to nonexisting/non-readable destination
- if ( -l $path ) {
+ if ( -l $path )
+ {
print "link: $path\n" if DEBUG;
- if ( $unlink ? $unlink->($path) : unlink($path) ) {
+ if ( $unlink ? $unlink->($path) : unlink($path) )
+ {
push @removes, $path;
}
next;
}
- unless ( -e $path ) {
+ unless ( -e $path )
+ {
print "missing: $path\n" if DEBUG;
- push @removes, $path; # Say we deleted it
+ push @removes, $path; # Say we deleted it
next;
}
my $can_delete;
- if ( IS_VMS ) {
+ if (IS_VMS)
+ {
$can_delete = VMS::Filespec::candelete($path);
- } elsif ( IS_WIN32 ) {
+ }
+ elsif (IS_WIN32)
+ {
# Assume we can delete it for the moment
$can_delete = 1;
- } elsif ( -w $path ) {
+ }
+ elsif ( -w $path )
+ {
# We have write permissions already
$can_delete = 1;
- } elsif ( $< == 0 ) {
+ }
+ elsif ( $< == 0 )
+ {
# Unixy and root
$can_delete = 1;
- } elsif ( (lstat($path))[4] == $< ) {
+ }
+ elsif ( ( lstat($path) )[4] == $< )
+ {
# I own the file
$can_delete = 1;
- } else {
+ }
+ else
+ {
# I don't think we can delete it
$can_delete = 0;
}
- unless ( $can_delete ) {
+ unless ($can_delete)
+ {
print "nowrite: $path\n" if DEBUG;
next;
}
- if ( -f $path ) {
+ if ( -f $path )
+ {
print "file: $path\n" if DEBUG;
- unless ( -w $path ) {
+ unless ( -w $path )
+ {
# Make the file writable (implementation from File::Path)
- (undef, undef, my $rp) = lstat $path or next;
- $rp &= 07777; # Don't forget setuid, setgid, sticky bits
- $rp |= 0600; # Turn on user read/write
+ ( undef, undef, my $rp ) = lstat $path or next;
+ $rp &= 07777; # Don't forget setuid, setgid, sticky bits
+ $rp |= 0600; # Turn on user read/write
chmod $rp, $path;
}
- if ( $unlink ? $unlink->($path) : unlink($path) ) {
+ if ( $unlink ? $unlink->($path) : unlink($path) )
+ {
# Failed to delete the file
next if -e $path;
push @removes, $path;
}
- } elsif ( -d $path ) {
+ }
+ elsif ( -d $path )
+ {
print "dir: $path\n" if DEBUG;
my $dir = File::Spec->canonpath($path);
# Do we need to move our cwd out of the location
# we are planning to delete?
my $chdir = _moveto($dir);
- if ( length $chdir ) {
+ if ( length $chdir )
+ {
chdir($chdir) or next;
}
- if ( $$recursive ) {
- if ( File::Path::rmtree( [ $dir ], DEBUG, 0 ) ) {
+ if ($$recursive)
+ {
+ if ( File::Path::rmtree( [$dir], DEBUG, 0 ) )
+ {
# Failed to delete the directory
next if -e $path;
push @removes, $path;
}
- } else {
- my ($save_mode) = (stat $dir)[2];
- chmod $save_mode & 0777, $dir; # just in case we cannot remove it.
- if ( $rmdir ? $rmdir->($dir) : rmdir($dir) ) {
+ }
+ else
+ {
+ my ($save_mode) = ( stat $dir )[2];
+ chmod $save_mode & 0777,
+ $dir; # just in case we cannot remove it.
+ if ( $rmdir ? $rmdir->($dir) : rmdir($dir) )
+ {
# Failed to delete the directory
next if -e $path;
push @removes, $path;
}
}
- } else {
+ }
+ else
+ {
print "???: $path\n" if DEBUG;
}
}
@@ -172,79 +205,91 @@ sub remove (@) {
return @removes;
}
-sub rm (@) {
+sub rm (@)
+{
goto &remove;
}
-sub trash (@) {
+sub trash (@)
+{
local $unlink = $unlink;
local $rmdir = $rmdir;
- if ( ref $_[0] eq 'HASH' ) {
- my %options = %{+shift @_};
+ if ( ref $_[0] eq 'HASH' )
+ {
+ my %options = %{ +shift @_ };
$unlink = $options{unlink};
$rmdir = $options{rmdir};
- } elsif ( IS_WIN32 ) {
+ }
+ elsif (IS_WIN32)
+ {
local $@;
eval 'use Win32::FileOp ();';
- die "Can't load Win32::FileOp to support the Recycle Bin: \$@ = $@" if length $@;
+ die "Can't load Win32::FileOp to support the Recycle Bin: \$@ = $@"
+ if length $@;
$unlink = \&Win32::FileOp::Recycle;
$rmdir = \&Win32::FileOp::Recycle;
- } elsif ( IS_MAC ) {
- unless ( $glue ) {
+ }
+ elsif (IS_MAC)
+ {
+ unless ($glue)
+ {
local $@;
eval 'use Mac::Glue ();';
- die "Can't load Mac::Glue::Finder to support the Trash Can: \$@ = $@" if length $@;
+ die
+"Can't load Mac::Glue::Finder to support the Trash Can: \$@ = $@"
+ if length $@;
$glue = Mac::Glue->new('Finder');
}
my $code = sub {
- my @files = map {
- Mac::Glue::param_type(
- Mac::Glue::typeAlias() => $_
- )
- } @_;
- $glue->delete(\@files);
+ my @files =
+ map { Mac::Glue::param_type( Mac::Glue::typeAlias() => $_ ) }
+ @_;
+ $glue->delete( \@files );
};
$unlink = $code;
$rmdir = $code;
- } else {
- die "Support for trash() on platform '$^O' not available at this time.\n";
+ }
+ else
+ {
+ die
+"Support for trash() on platform '$^O' not available at this time.\n";
}
remove(@_);
}
-sub undelete (@) {
+sub undelete (@)
+{
goto &trash;
}
-
-
-
-
######################################################################
# Support Functions
-sub _expand_with_opts {
+sub _expand_with_opts
+{
my $opts = shift;
- return ($opts->{glob} ? expand(@_) : @_);
+ return ( $opts->{glob} ? expand(@_) : @_ );
}
-sub expand (@) {
+sub expand (@)
+{
map { -e $_ ? $_ : File::Glob::bsd_glob($_) } @_;
}
# Do we need to move to a different directory to delete a directory,
# and if so which.
-sub _moveto {
+sub _moveto
+{
my $remove = File::Spec->rel2abs(shift);
my $cwd = @_ ? shift : Cwd::cwd();
# Do everything in absolute terms
- $remove = Cwd::abs_path( $remove );
- $cwd = Cwd::abs_path( $cwd );
+ $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 );
@@ -256,20 +301,18 @@ sub _moveto {
my @rd = File::Spec->splitdir($rd);
# Is the current directory the same as or inside the remove directory?
- unless ( @cd >= @rd ) {
+ unless ( @cd >= @rd )
+ {
return '';
}
- foreach ( 0 .. $#rd ) {
+ foreach ( 0 .. $#rd )
+ {
$cd[$_] eq $rd[$_] or return '';
}
# Confirmed, the current working dir is in the removal dir
pop @rd;
- return File::Spec->catpath(
- $rv,
- File::Spec->catdir(@rd),
- ''
- );
+ return File::Spec->catpath( $rv, File::Spec->catdir(@rd), '' );
}
1;
@@ -286,7 +329,7 @@ File::Remove - Remove files and directories
=head1 VERSION
-version 1.59
+version 1.60
=head1 SYNOPSIS
diff --git a/t/01_compile.t b/t/01_compile.t
index 72674e3..5c10bd6 100755
--- a/t/01_compile.t
+++ b/t/01_compile.t
@@ -3,11 +3,9 @@
# Tests that File::Remove compiles ok
use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
+use warnings;
use Test::More tests => 1;
-use_ok( 'File::Remove' );
+# TEST
+use_ok('File::Remove');
diff --git a/t/02_directories.t b/t/02_directories.t
index dc5edee..62c1914 100755
--- a/t/02_directories.t
+++ b/t/02_directories.t
@@ -1,149 +1,187 @@
#!/usr/bin/perl
use strict;
-BEGIN {
- $| = 1;
+
+BEGIN
+{
+ $| = 1;
$^W = 1;
}
use Test::More 'no_plan';
use File::Remove qw{ remove trash };
-
-
-
-
# Set up the tests
-my @dirs = ("$0.tmp", map { "$0.tmp/$_" } qw(a a/b c c/d e e/f g));
+my @dirs = ( "$0.tmp", map { "$0.tmp/$_" } qw(a a/b c c/d e e/f g) );
-for my $path ( reverse @dirs ) {
- if ( -e $path ) {
+for my $path ( reverse @dirs )
+{
+ if ( -e $path )
+ {
ok( rmdir($path), "rmdir: $path" );
- ok( !-e $path, "!-e: $path" );
+ ok( !-e $path, "!-e: $path" );
}
}
-for my $path ( @dirs ) {
- ok( ! -e $path, "!-e: $path" );
- ok( mkdir($path, 0777), "mkdir: $path" );
+for my $path (@dirs)
+{
+ ok( !-e $path, "!-e: $path" );
+ ok( mkdir( $path, 0777 ), "mkdir: $path" );
chmod 0777, $path;
- ok( -e $path, "-e: $path" );
+ ok( -e $path, "-e: $path" );
}
-for my $path (reverse @dirs) {
- ok( -e $path, "-e: $path" );
+for my $path ( reverse @dirs )
+{
+ ok( -e $path, "-e: $path" );
ok( rmdir($path), "rmdir: $path" );
- ok( !-e $path, "!-e: $path" );
+ ok( !-e $path, "!-e: $path" );
}
-for my $path ( @dirs ) {
- ok( ! -e $path, "!-e: $path" );
- ok( mkdir($path, 0777), "mkdir: $path" );
+for my $path (@dirs)
+{
+ ok( !-e $path, "!-e: $path" );
+ ok( mkdir( $path, 0777 ), "mkdir: $path" );
chmod 0777, $path;
- ok( -e $path, "-e: $path" );
+ ok( -e $path, "-e: $path" );
}
-for my $path (reverse @dirs) {
- ok( -e $path, "-e: $path" );
- ok( remove(\1, $path), "remove \\1: $path" );
- ok( !-e $path, "!-e: $path" );
+for my $path ( reverse @dirs )
+{
+ ok( -e $path, "-e: $path" );
+ ok( remove( \1, $path ), "remove \\1: $path" );
+ ok( !-e $path, "!-e: $path" );
}
-for my $path (@dirs) {
- ok( !-e $path, "!-e: $path" );
- ok( mkdir($path, 0777), "mkdir: $path" );
+for my $path (@dirs)
+{
+ ok( !-e $path, "!-e: $path" );
+ ok( mkdir( $path, 0777 ), "mkdir: $path" );
chmod 0777, $path;
- ok( -e $path, "-e: $path" );
+ ok( -e $path, "-e: $path" );
}
-for my $path (reverse @dirs) {
- ok( -e $path, "-e: $path" );
+for my $path ( reverse @dirs )
+{
+ ok( -e $path, "-e: $path" );
ok( remove($path), "remove: $path" );
- ok( !-e $path, "!-e: $path" );
+ ok( !-e $path, "!-e: $path" );
}
-for my $path (reverse @dirs) {
+for my $path ( reverse @dirs )
+{
ok( !-e $path, "-e: $path" );
- if (-e _) {
+ if ( -e _ )
+ {
ok( rmdir($path), "rmdir: $path" );
- ok( !-e $path, "!-e: $path" );
+ ok( !-e $path, "!-e: $path" );
}
}
-SKIP: {
- if ($^O eq 'darwin') {
+SKIP:
+{
+ if ( $^O eq 'darwin' )
+ {
+ ## no critic
eval 'use Mac::Glue ();';
skip "Undelete support requires Mac::Glue", 0 if length $@;
eval 'Mac::Glue->new("Finder")';
- skip "Undelete support requires Mac::Glue with Finder support", 0 if length $@;
- } elsif ($^O eq 'cygwin' || $^O =~ /^MSWin/) {
+ ## use critic
+ skip "Undelete support requires Mac::Glue with Finder support", 0
+ if length $@;
+ }
+ elsif ( $^O eq 'cygwin' || $^O =~ /^MSWin/ )
+ {
+ ## no critic
eval 'use Win32::FileOp::Recycle;';
+ ## use critic
skip "Undelete support requires Win32::FileOp::Recycle", 0 if length $@;
- } else {
+ }
+ else
+ {
skip "Undelete support not available by default", 0;
}
- for my $path (@dirs) {
- ok( !-e $path, "!-e: $path" );
- ok( mkdir($path, 0777), "mkdir: $path" );
+ for my $path (@dirs)
+ {
+ ok( !-e $path, "!-e: $path" );
+ ok( mkdir( $path, 0777 ), "mkdir: $path" );
chmod 0777, $path;
- ok( -e $path, "-e: $path" );
+ ok( -e $path, "-e: $path" );
}
- for my $path (reverse @dirs) {
- ok( -e $path, "-e: $path" );
+ for my $path ( reverse @dirs )
+ {
+ ok( -e $path, "-e: $path" );
ok( eval { trash($path) }, "trash: $path" );
- is( $@, '', "trash: \$@" );
- ok( !-e $path, "!-e: $path" );
+ is( $@, '', "trash: \$@" );
+ ok( !-e $path, "!-e: $path" );
}
- for my $path (reverse @dirs) {
+ for my $path ( reverse @dirs )
+ {
ok( !-e $path, "-e: $path" );
- if (-e _) {
+ if ( -e _ )
+ {
ok( rmdir($path), "rmdir: $path" );
- ok( !-e $path, "!-e: $path" );
+ ok( !-e $path, "!-e: $path" );
}
}
- for my $path (@dirs) {
- ok( !-e $path, "!-e: $path" );
- ok( mkdir($path, 0777), "mkdir: $path" );
+ for my $path (@dirs)
+ {
+ ok( !-e $path, "!-e: $path" );
+ ok( mkdir( $path, 0777 ), "mkdir: $path" );
chmod 0777, $path;
- ok( -e $path, "-e: $path" );
+ ok( -e $path, "-e: $path" );
}
- for my $path (reverse @dirs) {
- ok( -e $path, "-e: $path" );
+ for my $path ( reverse @dirs )
+ {
+ ok( -e $path, "-e: $path" );
ok( remove($path), "remove: $path" );
- ok( !-e $path, "!-e: $path" );
+ ok( !-e $path, "!-e: $path" );
}
- for my $path (reverse @dirs) {
+ for my $path ( reverse @dirs )
+ {
ok( !-e $path, "-e: $path" );
- if (-e _) {
+ if ( -e _ )
+ {
ok( rmdir($path), "rmdir: $path" );
- ok( !-e $path, "!-e: $path" );
+ ok( !-e $path, "!-e: $path" );
}
}
- for my $path (@dirs) {
- ok( !-e $path, "!-e: $path" );
- ok( mkdir($path, 0777), "mkdir: $path" );
+ for my $path (@dirs)
+ {
+ ok( !-e $path, "!-e: $path" );
+ ok( mkdir( $path, 0777 ), "mkdir: $path" );
chmod 0777, $path;
- ok( -e $path, "-e: $path" );
+ ok( -e $path, "-e: $path" );
}
- for my $path (reverse @dirs) {
- ok( -e $path, "-e: $path" );
+ for my $path ( reverse @dirs )
+ {
+ ok( -e $path, "-e: $path" );
ok(
- # Fake callbacks will not remove directories, so trash() would return empty list
- eval { trash({ 'rmdir' => sub { 1 }, 'unlink' => sub { 1 } }, $path); 1 },
+# Fake callbacks will not remove directories, so trash() would return empty list
+ eval {
+ trash(
+ {
+ 'rmdir' => sub { 1 },
+ 'unlink' => sub { 1 }
+ },
+ $path
+ );
+ 1;
+ },
"trash: $path",
);
- ok( -e $path, "-e: $path" );
+ ok( -e $path, "-e: $path" );
ok( rmdir($path), "rmdir: $path" );
- ok( !-e $path, "!-e: $path" );
+ ok( !-e $path, "!-e: $path" );
}
- UNDELETE: 1;
+UNDELETE: 1;
}
diff --git a/t/03_deep_readonly.t b/t/03_deep_readonly.t
index a88c2db..37758ae 100755
--- a/t/03_deep_readonly.t
+++ b/t/03_deep_readonly.t
@@ -3,67 +3,89 @@
# Test that File::Remove can recursively remove a directory that
# deeply contains a readonly file that is owned by the current user.
use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
+use warnings;
use Test::More tests => 12;
use File::Spec::Functions ':ALL';
use File::Copy ();
use File::Remove ();
-
-
-
-
#####################################################################
# Set up for the test
my $in = catdir( curdir(), 't' );
+
+# TEST
ok( -d $in, 'Found t dir' );
my $d1 = catdir( $in, 'd1' );
my $d2 = catdir( $d1, 'd2' );
my $f3 = catfile( $d2, 'f3.txt' );
-sub create_directory {
- mkdir($d1,0777) or die "Failed to create $d1";
+sub create_directory
+{
+ mkdir( $d1, 0777 ) or die "Failed to create $d1";
+
+ # TEST
ok( -d $d1, "Created $d1 ok" );
+
+ # TEST
ok( -r $d1, "Created $d1 -r" );
+
+ # TEST
ok( -w $d1, "Created $d1 -w" );
- mkdir($d2,0777) or die "Failed to create $d2";
+ mkdir( $d2, 0777 ) or die "Failed to create $d2";
+
+ # TEST
ok( -d $d2, "Created $d2 ok" );
+
+ # TEST
ok( -r $d2, "Created $d2 -r" );
+
+ # TEST
ok( -w $d2, "Created $d2 -w" );
- # Copy in a known-readonly file (in this case, the File::Spec lib we are using
+
+ # Copy in a known-readonly file (in this case, the File::Spec lib we are using
File::Copy::copy( $INC{'File/Spec.pm'} => $f3 );
chmod( 0400, $f3 );
+
+ # TEST
ok( -f $f3, "Created $f3 ok" );
+
+ # TEST
ok( -r $f3, "Created $f3 -r" );
- SKIP: {
- if ( $^O ne 'MSWin32' and ($< == 0 or $> == 0) ) {
- skip("This test doesn't work as root", 1);
+SKIP:
+ {
+ if ( $^O ne 'MSWin32' and ( $< == 0 or $> == 0 ) )
+ {
+ skip( "This test doesn't work as root", 1 );
}
- if ( $^O eq 'cygwin' ) {
- skip("Fails on some cygwin and shouldn't prevent install",1);
+ if ( $^O eq 'cygwin' )
+ {
+ skip( "Fails on some cygwin and shouldn't prevent install", 1 );
}
- ok( ! -w $f3, "Created $f3 ! -w" );
- };
+
+ # TEST
+ ok( !-w $f3, "Created $f3 ! -w" );
+ }
}
-sub clear_directory {
- if ( -e $f3 ) {
+sub clear_directory
+{
+ if ( -e $f3 )
+ {
chmod( 0700, $f3 ) or die "chmod 0700 $f3 failed";
- unlink( $f3 ) or die "unlink: $f3 failed";
- ! -e $f3 or die "unlink didn't work";
+ unlink($f3) or die "unlink: $f3 failed";
+ !-e $f3 or die "unlink didn't work";
}
- if ( -e $d2 ) {
- rmdir( $d2 ) or die "rmdir: $d2 failed";
- ! -e $d2 or die "rmdir didn't work";
+ if ( -e $d2 )
+ {
+ rmdir($d2) or die "rmdir: $d2 failed";
+ !-e $d2 or die "rmdir didn't work";
}
- if ( -e $d1 ) {
- rmdir( $d1 ) or die "rmdir: $d1 failed";
- ! -e $d1 or die "rmdir didn't work";
+ if ( -e $d1 )
+ {
+ rmdir($d1) or die "rmdir: $d1 failed";
+ !-e $d1 or die "rmdir didn't work";
}
}
@@ -74,17 +96,17 @@ clear_directory();
create_directory();
# Schedule cleanup
-END {
+END
+{
clear_directory();
}
-
-
-
-
#####################################################################
# Main Testing
# Call a recursive remove of the directory, nothing should be left after
+# TEST
ok( File::Remove::remove( \1, $d1 ), "remove('$d1') ok" );
-ok( ! -e $d1, "Removed the directory ok" );
+
+# TEST
+ok( !-e $d1, "Removed the directory ok" );
diff --git a/t/04_can_delete.t b/t/04_can_delete.t
index 5ed55a2..4d72430 100644
--- a/t/04_can_delete.t
+++ b/t/04_can_delete.t
@@ -3,68 +3,90 @@
# Test that File::Remove can recursively remove a directory that
# deeply contains a readonly file that is owned by the current user.
use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
+use warnings;
use Test::More tests => 12;
use File::Spec::Functions ':ALL';
use File::Copy ();
use File::Remove ();
-
-
-
-
#####################################################################
# Set up for the test
my $in = catdir( curdir(), 't', "04_can_delete-t.tmp" );
mkdir($in);
+
+# TEST
ok( -d $in, 'Found t dir' );
my $d1 = catdir( $in, 'd1' );
my $d2 = catdir( $d1, 'd2' );
my $f3 = catfile( $d2, 'f3.txt' );
-sub create_directory {
- mkdir($d1,0777) or die "Failed to create $d1";
+sub create_directory
+{
+ mkdir( $d1, 0777 ) or die "Failed to create $d1";
+
+ # TEST
ok( -d $d1, "Created $d1 ok" );
+
+ # TEST
ok( -r $d1, "Created $d1 -r" );
+
+ # TEST
ok( -w $d1, "Created $d1 -w" );
- mkdir($d2,0777) or die "Failed to create $d2";
+ mkdir( $d2, 0777 ) or die "Failed to create $d2";
+
+ # TEST
ok( -d $d2, "Created $d2 ok" );
+
+ # TEST
ok( -r $d2, "Created $d2 -r" );
+
+ # TEST
ok( -w $d2, "Created $d2 -w" );
- # Copy in a known-readonly file (in this case, the File::Spec lib we are using
+
+ # Copy in a known-readonly file (in this case, the File::Spec lib we are using
File::Copy::copy( $INC{'File/Spec.pm'} => $f3 );
chmod( 0400, $f3 );
+
+ # TEST
ok( -f $f3, "Created $f3 ok" );
+
+ # TEST
ok( -r $f3, "Created $f3 -r" );
- SKIP: {
- if ( $^O ne 'MSWin32' and $< == 0 ) {
- skip("This test doesn't work as root", 1);
+SKIP:
+ {
+ if ( $^O ne 'MSWin32' and $< == 0 )
+ {
+ skip( "This test doesn't work as root", 1 );
}
- if ( $^O eq 'cygwin' ) {
- skip("Fails on some cygwin and shouldn't prevent install",1);
+ if ( $^O eq 'cygwin' )
+ {
+ skip( "Fails on some cygwin and shouldn't prevent install", 1 );
}
- ok( ! -w $f3, "Created $f3 ! -w" );
- };
+
+ # TEST
+ ok( !-w $f3, "Created $f3 ! -w" );
+ }
}
-sub clear_directory {
- if ( -e $f3 ) {
+sub clear_directory
+{
+ if ( -e $f3 )
+ {
chmod( 0700, $f3 ) or die "chmod 0700 $f3 failed";
- unlink( $f3 ) or die "unlink: $f3 failed";
- ! -e $f3 or die "unlink didn't work";
+ unlink($f3) or die "unlink: $f3 failed";
+ !-e $f3 or die "unlink didn't work";
}
- if ( -e $d2 ) {
- rmdir( $d2 ) or die "rmdir: $d2 failed";
- ! -e $d2 or die "rmdir didn't work";
+ if ( -e $d2 )
+ {
+ rmdir($d2) or die "rmdir: $d2 failed";
+ !-e $d2 or die "rmdir didn't work";
}
- if ( -e $d1 ) {
- rmdir( $d1 ) or die "rmdir: $d1 failed";
- ! -e $d1 or die "rmdir didn't work";
+ if ( -e $d1 )
+ {
+ rmdir($d1) or die "rmdir: $d1 failed";
+ !-e $d1 or die "rmdir didn't work";
}
}
@@ -75,17 +97,17 @@ clear_directory();
create_directory();
# Schedule cleanup
-END {
+END
+{
clear_directory();
}
-
-
-
-
#####################################################################
# Main Testing
# Call a recursive remove of the directory, nothing should be left after
-is_deeply( [ File::Remove::remove( $f3 ) ], [ $f3 ], "remove('$f3') ok" );
-ok( ! -e $f3, "Removed the file ok" );
+# TEST
+is_deeply( [ File::Remove::remove($f3) ], [$f3], "remove('$f3') ok" );
+
+# TEST
+ok( !-e $f3, "Removed the file ok" );
diff --git a/t/05_links.t b/t/05_links.t
index 2be51dd..0ab8a0e 100644
--- a/t/05_links.t
+++ b/t/05_links.t
@@ -1,8 +1,10 @@
#!/usr/bin/perl
use strict;
-BEGIN {
- $| = 1;
+
+BEGIN
+{
+ $| = 1;
$^W = 1;
}
@@ -10,8 +12,9 @@ use Test::More;
use File::Spec::Functions ':ALL';
use File::Remove ();
-unless( eval { symlink("",""); 1 } ) {
- plan("skip_all" => "No Unix-like symlinks");
+unless ( eval { symlink( "", "" ); 1 } )
+{
+ plan( "skip_all" => "No Unix-like symlinks" );
exit(0);
}
@@ -19,38 +22,46 @@ plan( tests => 8 );
# Set up the tests
my $testdir = catdir( 't', 'linktest' );
-if ( -d $testdir ) {
+if ( -d $testdir )
+{
File::Remove::remove( \1, $testdir );
die "Failed to clear test directory '$testdir'" if -d $testdir;
}
-ok( ! -d $testdir, 'Cleared testdir' );
-unless( mkdir($testdir, 0777) ) {
+ok( !-d $testdir, 'Cleared testdir' );
+unless ( mkdir( $testdir, 0777 ) )
+{
die("Cannot create test directory '$testdir': $!");
}
ok( -d $testdir, 'Created testdir' );
my %links = (
- l_ex => curdir(),
-# l_ex_a => rootdir(),
- l_nex => 'does_not_exist'
+ l_ex => curdir(),
+
+ # l_ex_a => rootdir(),
+ l_nex => 'does_not_exist'
);
my $errs = 0;
-foreach my $link (keys %links) {
+foreach my $link ( keys %links )
+{
my $path = catdir( $testdir, $link );
- unless( symlink($links{$link}, $path )) {
+ unless ( symlink( $links{$link}, $path ) )
+ {
diag("Cannot create symlink $link -> $links{$link}: $!");
$errs++;
}
}
-if ( $errs ) {
+if ($errs)
+{
die("Could not create test links");
}
-ok( File::Remove::remove(\1, map { catdir($testdir, $_) } keys %links), "remove \\1: all links" );
+ok( File::Remove::remove( \1, map { catdir( $testdir, $_ ) } keys %links ),
+ "remove \\1: all links" );
my @entries;
-ok( opendir(DIR, $testdir) );
-foreach my $dir ( readdir(DIR) ) {
+ok( opendir( DIR, $testdir ) );
+foreach my $dir ( readdir(DIR) )
+{
next if $dir eq curdir();
next if $dir eq updir();
push @entries, $dir;
@@ -59,6 +70,6 @@ ok( closedir(DIR) );
ok( @entries == 0, "no links remained in directory; found @entries" );
-ok( File::Remove::remove(\1, $testdir), "remove \\1: $testdir" );
+ok( File::Remove::remove( \1, $testdir ), "remove \\1: $testdir" );
-ok( ! -e $testdir, "!-e: $testdir" );
+ok( !-e $testdir, "!-e: $testdir" );
diff --git a/t/06_curly.t b/t/06_curly.t
index 9c78d02..582d8b1 100644
--- a/t/06_curly.t
+++ b/t/06_curly.t
@@ -5,10 +5,7 @@
# Test that a directory called '{1234}' is deleted correctly.
use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
+use warnings;
use Test::More tests => 6;
use File::Spec::Functions ':ALL';
@@ -17,21 +14,35 @@ use File::Remove ();
# Create the test directory
my $dir = '{1234}';
my $path = catdir( 't', '{1234}' );
-unless ( -e $path ) {
- mkdir($path,0777);
+unless ( -e $path )
+{
+ mkdir( $path, 0777 );
}
+
+# TEST
ok( -e $path, "Test directory $path exists" );
# Delete the test directory
my @removed = File::Remove::remove( \1, $path );
-is_deeply( \@removed, [ $path ], 'remove returns as expected' );
-ok( ! -e $path, "remove deletes the $path directory" );
+
+# TEST
+is_deeply( \@removed, [$path], 'remove returns as expected' );
+
+# TEST
+ok( !-e $path, "remove deletes the $path directory" );
# Repeat the tests on a dir named {1234} in the root path
-unless ( -e $dir ) {
- mkdir($dir,0777);
+unless ( -e $dir )
+{
+ mkdir( $dir, 0777 );
}
+
+# TEST
ok( -e $dir, "Test directory $dir exists" );
@removed = File::Remove::remove( \1, $dir );
-is_deeply( \@removed, [ $dir ], 'remove returns as expected' );
-ok( ! -e $path, "remove delete the $dir directory" );
+
+# TEST
+is_deeply( \@removed, [$dir], 'remove returns as expected' );
+
+# TEST
+ok( !-e $path, "remove delete the $dir directory" );
diff --git a/t/07_cwd.t b/t/07_cwd.t
index 992e7d8..0b16cdc 100644
--- a/t/07_cwd.t
+++ b/t/07_cwd.t
@@ -1,7 +1,9 @@
#!/usr/bin/perl
use strict;
-BEGIN {
+
+BEGIN
+{
$| = 1;
$^W = 1;
}
@@ -12,43 +14,55 @@ use File::Remove ();
use Cwd ();
# Create the test directories
-my $base = Cwd::abs_path(Cwd::cwd());
-my $cwd = rel2abs(catdir('t', 'cwd'));
-my $foo = rel2abs(catdir('t', 'cwd', 'foo'));
-my $file = rel2abs(catdir('t', 'cwd', 'foo', 'bar.txt'));
+my $base = Cwd::abs_path( Cwd::cwd() );
+my $cwd = rel2abs( catdir( 't', 'cwd' ) );
+my $foo = rel2abs( catdir( 't', 'cwd', 'foo' ) );
+my $file = rel2abs( catdir( 't', 'cwd', 'foo', 'bar.txt' ) );
File::Remove::clear($cwd);
-mkdir($cwd,0777) or die "mkdir($cwd): $!";
-mkdir($foo,0777) or die "mkdir($foo): $!";
-open( FILE, ">$file" ) or die "open($file): $!";
-print FILE "blah\n";
-close( FILE ) or die "close($file): $!";
-ok( -d $cwd, "$cwd directory exists" );
-ok( -d $foo, "$foo directory exists" );
-ok( -f $file, "$file file exists" );
+mkdir( $cwd, 0777 ) or die "mkdir($cwd): $!";
+mkdir( $foo, 0777 ) or die "mkdir($foo): $!";
+open( my $fh, ">", $file ) or die "open($file): $!";
+print {$fh} "blah\n";
+close($fh) or die "close($file): $!";
+
+# TEST
+ok( -d $cwd, "$cwd directory exists" );
+
+# TEST
+ok( -d $foo, "$foo directory exists" );
+
+# TEST
+ok( -f $file, "$file file exists" );
# Test that _moveto behaves as expected
-SCOPE: {
+SCOPE:
+{
+ # TEST
is(
File::Remove::_moveto(
- File::Spec->catdir($base, 't'), # remove
- File::Spec->catdir($base), # cwd
+ 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
+ File::Spec->catdir( $base, 't' ), # remove
+ File::Spec->catdir( $base, 't' ), # cwd
);
$moveto1 =~ s/\\/\//g;
+
+ # TEST
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
+ File::Spec->catdir( $base, 't' ), # remove
+ File::Spec->catdir( $base, 't', 'cwd' ), # cwd
);
$moveto2 =~ s/\\/\//g;
+
+ # TEST
is( $moveto2, $base, '_moveto returns correct for normal case' );
# Regression: _moveto generates false positives
@@ -56,10 +70,11 @@ SCOPE: {
# remove: /tmp/eBtQxTPGHC
# moveto: /tmp
# expected: ''
+ # TEST
is(
File::Remove::_moveto(
- File::Spec->catdir($base, 't'), # remove
- File::Spec->catdir($base, 'lib', 'File'), # cwd
+ File::Spec->catdir( $base, 't' ), # remove
+ File::Spec->catdir( $base, 'lib', 'File' ), # cwd
),
'',
'_moveto returns null as expected',
@@ -69,21 +84,32 @@ SCOPE: {
# Change the current working directory into the first
# test directory and store the absolute path.
chdir($cwd) or die "chdir($cwd): $!";
-my $cwdabs = Cwd::abs_path(Cwd::cwd());
+my $cwdabs = Cwd::abs_path( Cwd::cwd() );
+
+# TEST
ok( $cwdabs =~ /\bcwd$/, "Expected abs path is $cwdabs" );
# Change into the directory that should be deleted
chdir('foo') or die "chdir($foo): $!";
-my $fooabs = Cwd::abs_path(Cwd::cwd());
+my $fooabs = Cwd::abs_path( Cwd::cwd() );
+
+# TEST
ok( $fooabs =~ /\bfoo$/, "Deleting from abs path is $fooabs" );
# Delete the foo directory
-ok( File::Remove::remove(\1, $foo), "remove($foo) ok" );
+# TEST
+ok( File::Remove::remove( \1, $foo ), "remove($foo) ok" );
# We should now be in the bottom directory again
-is( Cwd::abs_path(Cwd::cwd()), $cwdabs, "We are now back in the original directory" );
+# TEST
+is( Cwd::abs_path( Cwd::cwd() ),
+ $cwdabs, "We are now back in the original directory" );
# Move back to the base dir and confirm everything was deleted.
chdir($base) or die "chdir($base): $!";
-ok( ! -e $foo, "$foo does not exist" );
-ok( ! -e $file, "$file does not exist" );
+
+# TEST
+ok( !-e $foo, "$foo does not exist" );
+
+# TEST
+ok( !-e $file, "$file does not exist" );
diff --git a/t/08_spaces.t b/t/08_spaces.t
index 8817811..ef9f9a7 100644
--- a/t/08_spaces.t
+++ b/t/08_spaces.t
@@ -4,7 +4,10 @@
# spaces in the path to delete.
use strict;
-BEGIN {
+use warnings;
+
+BEGIN
+{
$| = 1;
$^W = 1;
}
@@ -14,51 +17,54 @@ use File::Spec::Functions ':ALL';
use File::Copy ();
use File::Remove ();
-
-
-
-
#####################################################################
# Set up for the test
my $t = catdir( curdir(), 't' );
-my $s = catdir( $t, 'spaced path' );
-my $f1 = catfile( $s, 'foo1.txt' );
-my $f2 = catfile( $s, 'foo2.txt' );
-my $f3 = catfile( $s, 'bar.txt' );
-
-sub create_directory {
- mkdir($s,0777) or die "Failed to create $s";
+my $s = catdir( $t, 'spaced path' );
+my $f1 = catfile( $s, 'foo1.txt' );
+my $f2 = catfile( $s, 'foo2.txt' );
+my $f3 = catfile( $s, 'bar.txt' );
+
+sub create_directory
+{
+ mkdir( $s, 0777 ) or die "Failed to create $s";
ok( -d $s, "Created $s ok" );
ok( -r $s, "Created $s -r" );
ok( -w $s, "Created $s -w" );
- open( FILE, ">$f1" ) or die "Failed to create $f1";
- print FILE "Test\n";
- close FILE;
- open( FILE, ">$f2" ) or die "Failed to create $f2";
- print FILE "Test\n";
- close FILE;
- open( FILE, ">$f3" ) or die "Failed to create $f3";
- print FILE "Test\n";
- close FILE;
+ my $spew = sub {
+ my $fn = shift;
+ open( my $fh, ">", $fn ) or die "Failed to create $fn";
+ print {$fh} "Test\n";
+ close $fh;
+ return;
+ };
+ $spew->($f1);
+ $spew->($f2);
+ $spew->($f3);
}
-sub clear_directory {
- if ( -e $f1 ) {
- unlink( $f1 ) or die "unlink: $f1 failed";
- ! -e $f1 or die "unlink didn't work";
+sub clear_directory
+{
+ if ( -e $f1 )
+ {
+ unlink($f1) or die "unlink: $f1 failed";
+ !-e $f1 or die "unlink didn't work";
}
- if ( -e $f2 ) {
- unlink( $f2 ) or die "unlink: $f2 failed";
- ! -e $f2 or die "unlink didn't work";
+ if ( -e $f2 )
+ {
+ unlink($f2) or die "unlink: $f2 failed";
+ !-e $f2 or die "unlink didn't work";
}
- if ( -e $f3 ) {
- unlink( $f3 ) or die "unlink: $f3 failed";
- ! -e $f3 or die "unlink didn't work";
+ if ( -e $f3 )
+ {
+ unlink($f3) or die "unlink: $f3 failed";
+ !-e $f3 or die "unlink didn't work";
}
- if ( -e $s ) {
- rmdir( $s ) or die "rmdir: $s failed";
- ! -e $s or die "rmdir didn't work";
+ if ( -e $s )
+ {
+ rmdir($s) or die "rmdir: $s failed";
+ !-e $s or die "rmdir didn't work";
}
}
@@ -69,14 +75,11 @@ clear_directory();
create_directory();
# Schedule cleanup
-END {
+END
+{
clear_directory();
}
-
-
-
-
#####################################################################
# Main Testing
diff --git a/t/09_fork.t b/t/09_fork.t
index 7c9723c..2bc7fc0 100644
--- a/t/09_fork.t
+++ b/t/09_fork.t
@@ -3,10 +3,7 @@
# Ensure that we don't prematurely END-time delete due to forking
use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
+use warnings;
use Test::More tests => 8;
use File::Spec::Functions ':ALL';
@@ -14,17 +11,26 @@ use File::Remove ();
# Create a directory
my $parent = catdir( 't', '09_fork_parent' );
-my $child = catdir( 't', '09_fork_child' );
+my $child = catdir( 't', '09_fork_child' );
File::Remove::clear($parent);
File::Remove::remove($child);
-ok( ! -d $parent, 'Parent directory does not exist' );
-ok( ! -d $child, 'Child directory does not exist' );
+
+# TEST
+ok( !-d $parent, 'Parent directory does not exist' );
+
+# TEST
+ok( !-d $child, 'Child directory does not exist' );
+
+# TEST
ok( mkdir( $parent, 0777 ), 'Created directory' );
+
+# TEST
ok( -d $parent, 'Directory exists' );
# Fork the test
my $pid = fork();
-unless ( $pid ) {
+unless ($pid)
+{
# Create a child-owned directory and flag for deletion
File::Remove::clear($child);
mkdir( $child, 0777 );
@@ -37,11 +43,19 @@ unless ( $pid ) {
# In the parent, wait 1 second for process to spawn
# and create the child directory
sleep(1);
+
+# TEST
ok( -d $child, 'Child directory created (by forked child)' );
# Wait for the child to exit
my $caught = wait();
+
+# TEST
is( $pid, $caught, 'The child exited' );
-sleep(1); # Give a chance for flakey windows to delete directory
+sleep(1); # Give a chance for flakey windows to delete directory
+
+# TEST
ok( -d $parent, 'Parent directory still exists' );
-ok( ! -d $child, 'Child directory is removed' );
+
+# TEST
+ok( !-d $child, 'Child directory is removed' );
diff --git a/t/10_noglob.t b/t/10_noglob.t
index 8590e27..d114670 100644
--- a/t/10_noglob.t
+++ b/t/10_noglob.t
@@ -6,7 +6,7 @@ use warnings;
use 5.006;
use File::Spec ();
-use Cwd (qw/getcwd/);
+use Cwd (qw/getcwd/);
use File::Path qw/rmtree/;
@@ -16,45 +16,42 @@ use File::Remove qw/remove/;
{
my $dir = File::Spec->rel2abs(
- File::Spec->catdir(
- File::Spec->curdir(), "t", "10_noglob_dir",
- )
- );
+ File::Spec->catdir( File::Spec->curdir(), "t", "10_noglob_dir", ) );
mkdir($dir);
my $file_path = sub {
my ($bn) = @_;
- return File::Spec->catfile($dir, $bn);
+ return File::Spec->catfile( $dir, $bn );
};
my $create_file = sub {
- my ($bn, $contents) = @_;
+ my ( $bn, $contents ) = @_;
open my $fh, '>', $file_path->($bn)
or die "Cannot create basename '$bn'";
print {$fh} $contents;
- close ($fh);
+ close($fh);
return;
};
- $create_file->("a", "a contents\n");
- $create_file->("b", "b contents\n");
- $create_file->("c", "c contents\n");
+ $create_file->( "a", "a contents\n" );
+ $create_file->( "b", "b contents\n" );
+ $create_file->( "c", "c contents\n" );
my $cur_dir = getcwd();
- chdir ($dir);
+ chdir($dir);
- remove(\0, +{ glob => 0 }, '*');
+ remove( \0, +{ glob => 0 }, '*' );
my $is_file = sub {
my ($bn) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
- return ok (scalar(-e $file_path->($bn)), "$bn was not deleted.");
+ return ok( scalar( -e $file_path->($bn) ), "$bn was not deleted." );
};
# TEST
@@ -66,8 +63,8 @@ use File::Remove qw/remove/;
# TEST
$is_file->('c');
- chdir ($cur_dir);
+ chdir($cur_dir);
- rmtree ($dir);
+ rmtree($dir);
}
diff --git a/xt/author/tidyall.t b/xt/author/tidyall.t
new file mode 100644
index 0000000..4d226bc
--- /dev/null
+++ b/xt/author/tidyall.t
@@ -0,0 +1,11 @@
+# This file was automatically generated by Dist::Zilla::Plugin::Test::TidyAll v$VERSION
+
+use Test::More 0.88;
+use Test::Code::TidyAll 0.24;
+
+tidyall_ok(
+ verbose => ( exists $ENV{TEST_TIDYALL_VERBOSE} ? $ENV{TEST_TIDYALL_VERBOSE} : 0 ),
+ jobs => ( exists $ENV{TEST_TIDYALL_JOBS} ? $ENV{TEST_TIDYALL_JOBS} : 1 ),
+);
+
+done_testing;