Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

extracted make_file from dist_info.t to be in MyTestHelper module, st…

…arted tests for CleanupHelper
  • Loading branch information...
commit 4c886768a2949434382196cbe6b915c1c00f57b5 1 parent 81e7e95
@jberger authored
View
2  lib/Moodule/Build/Role/CleanupHelper.pm
@@ -17,7 +17,7 @@ sub add_to_cleanup {
my $self = shift;
my $cleanup = $self->cleanup;
my %files = map {localize_file_path($_), 1} @_;
- %$cleanup = %$cleanup, %files;
+ %$cleanup = (%$cleanup, %files);
}
sub delete_filetree {
View
49 t/MyTestHelper.pm
@@ -0,0 +1,49 @@
+package MyTestHelper;
+
+use strict;
+use warnings;
+
+use Cwd 'getcwd';
+use File::Spec ();
+
+use Exporter 'import';
+
+our @EXPORT = ( qw/
+ make_file
+/ );
+
+sub make_file {
+ my $opts = ref $_[-1] ? pop : {};
+ my $content = pop;
+ my $filename = pop;
+ my @path = @_;
+
+ my $old = getcwd;
+
+ for my $dir (@path) {
+ unless (-d $dir) {
+ mkdir $dir or die "Cannot create new dir $dir\n";
+ }
+ chdir $dir or die "Cannot chdir into $dir\n";
+ }
+
+ open my $fh, '>', $filename;
+ print $fh "$content";
+
+ chdir $old;
+
+ my $filepath = File::Spec->catfile(@path, $filename);
+ my $unix_filepath = join '/', @path, $filename;
+
+ if ($opts->{test}) {
+ require Test::More;
+ Test::More::ok( -e $filepath, "File $filepath created" );
+ }
+
+ return wantarray ? ($filepath, $unix_filepath) : $filepath;
+
+}
+
+1;
+
+
View
60 t/cleanup.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+
+use File::Temp ();
+use Cwd qw/getcwd/;
+
+use lib 't';
+use MyTestHelper;
+
+use Test::More;
+
+my $old = getcwd;
+my $dir = File::Temp->newdir;
+chdir $dir or die "Cannot chdir to $dir\n";
+
+open my $verbose_handle, '>', \my $verbose;
+open my $info_handle, '>', \my $info;
+
+{
+ package MyTestClass;
+ use Moo;
+ with 'Moodule::Build::Role::CleanupHelper';
+ sub log_info { print $info_handle @_ }
+ sub log_verbose { print $verbose_handle @_ }
+ sub depends_on { 1 }
+}
+
+subtest 'add via accessor' => sub {
+ my $filename = 'testfile';
+ my (undef, $file) = make_file( qw/File Test/, $filename, 'Testing', {test => 1} );
+
+ my $mb = MyTestClass->new;
+ $mb->add_to_cleanup($file);
+
+ $verbose = $info = '';
+ $mb->ACTION_clean;
+ ok( $info, 'clean message' );
+ like $verbose, qr/\Q$filename/, 'file deletion message';
+ ok( ! -e $file, 'File removed' );
+};
+
+subtest 'add via constructor' => sub {
+ my $filename = 'testfile';
+ my (undef, $file) = make_file( qw/File Test/, $filename, 'Testing', {test => 1} );
+
+ my $mb = MyTestClass->new(
+ cleanup => { $file => 1 },
+ );
+
+ $verbose = $info = '';
+ $mb->ACTION_clean;
+ ok( $info, 'clean message' );
+ like $verbose, qr/\Q$filename/, 'file deletion message';
+ ok( ! -e $file, 'File removed' );
+};
+
+chdir $old;
+
+done_testing;
+
View
21 t/dist_info.t
@@ -1,6 +1,9 @@
use strict;
use warnings;
+use lib 't';
+use MyTestHelper;
+
use Test::More;
use File::Temp ();
@@ -76,21 +79,3 @@ subtest 'Constructor without either name' => sub {
done_testing;
-sub make_file {
- my $content = pop;
- my $filename = pop;
-
- my $old = getcwd;
-
- for my $dir (@_) {
- mkdir $dir or die "Cannot create new dir $dir\n";
- chdir $dir or die "Cannot chdir into $dir\n";
- }
-
- open my $fh, '>', $filename;
- print $fh "$content";
-
- chdir $old;
-
-}
-
Please sign in to comment.
Something went wrong with that request. Please try again.