From 29d7f44557751a2af6c423bf7e4c589f48ec2b0b Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Tue, 23 Jun 2015 12:41:31 +1200 Subject: [PATCH 1/6] Add Test::TempDir::Tiny 0.005-pre-release verbatim in t/tlib. Dependency changes: @@ -86,11 +86,11 @@ "runtime" : { "requires" : { "Carp" : "0", - "Exporter" : "0", + "Exporter" : "5.57", "File::Basename" : "0", "File::Copy" : "0", "File::Find" : "0", - "File::Path" : "0", + "File::Path" : "2.01", "File::Spec" : "0.8", "perl" : "5.006", "strict" : "0", @@ -102,11 +102,17 @@ "CPAN::Meta" : "2.120900" }, "requires" : { + "B" : "0", "Cwd" : "0", "Data::Dumper" : "0", + "Exporter" : "5.57", "ExtUtils::MakeMaker" : "0", + "File::Path" : "2.01", "File::Spec" : "0.8", + "File::Spec::Functions" : "0", + "File::Temp" : "0", "Test::More" : "0", + "lib" : "0", "perl" : "5.006" } } --- t/tlib/Test/TempDir/Tiny.pm | 306 ++++++++++++++++++++++++++++++++++++ 1 file changed, 306 insertions(+) create mode 100644 t/tlib/Test/TempDir/Tiny.pm diff --git a/t/tlib/Test/TempDir/Tiny.pm b/t/tlib/Test/TempDir/Tiny.pm new file mode 100644 index 0000000..b91f64e --- /dev/null +++ b/t/tlib/Test/TempDir/Tiny.pm @@ -0,0 +1,306 @@ +use 5.006; +use strict; +use warnings; + +package Test::TempDir::Tiny; +# ABSTRACT: Temporary directories that stick around when tests fail + +our $VERSION = '0.005'; + +use Exporter 5.57 qw/import/; +our @EXPORT = qw/tempdir in_tempdir/; + +use Carp qw/confess/; +use Cwd qw/abs_path/; +use Errno qw/EEXIST ENOENT/; +{ + no warnings 'numeric'; # loading File::Path has non-numeric warnings on 5.8 + use File::Path 2.01 qw/remove_tree/; +} +use File::Spec::Functions qw/catdir/; +use File::Temp; + +my ( $ROOT_DIR, $TEST_DIR, %COUNTER ); +my ( $ORIGINAL_PID, $ORIGINAL_CWD, $TRIES, $DELAY, $SYSTEM_TEMP ) = + ( $$, abs_path("."), 100, 50 / 1000, 0 ); + +=func tempdir + + $dir = tempdir(); # .../default_1/ + $dir = tempdir("label"); # .../label_1/ + +Creates a directory underneath a test-file-specific temporary directory and +returns the absolute path to it in platform-native form (i.e. with backslashes +on Windows). + +The function takes a single argument as a label for the directory or defaults +to "default". An incremental counter value will be appended to allow a label to +be used within a loop with distinct temporary directories: + + # t/foo.t + + for ( 1 .. 3 ) { + tempdir("in loop"); + } + + # creates: + # ./tmp/t_foo_t/in_loop_1 + # ./tmp/t_foo_t/in_loop_2 + # ./tmp/t_foo_t/in_loop_3 + +If the label contains any characters besides alphanumerics, underscore +and dash, they will be collapsed and replaced with a single underscore. + + $dir = tempdir("a space"); # .../a_space_1/ + $dir = tempdir("a!bang"); # .../a_bang_1/ + +The test-file-specific directory and all directories within it will be cleaned +up with an END block if the current test file passes tests. + +=cut + +sub tempdir { + my $label = defined( $_[0] ) ? $_[0] : 'default'; + $label =~ tr{a-zA-Z0-9_-}{_}cs; + + _init() unless $ROOT_DIR && $TEST_DIR; + my $suffix = ++$COUNTER{$label}; + my $subdir = catdir( $TEST_DIR, "${label}_${suffix}" ); + mkdir $subdir or confess("Couldn't create $subdir: $!"); + return $subdir; +} + +=func in_tempdir + + in_tempdir "label becomes name" => sub { + my $cwd = shift; + # this happens in tempdir + }; + +Given a label and a code reference, creates a temporary directory based on the +label (following the rules of L), changes to that directory, runs the +code, then changes back to the original directory. + +The temporary directory path is given as an argument to the code reference. +The code runs in the same context as C and C returns +the return value(s) from the code. + +When the code finishes (even if it dies), C will change back to the +original directory if it can, to the root if it can't, and will rethrow any +fatal errors. + +=cut + +sub in_tempdir { + my ( $label, $code ) = @_; + my $wantarray = wantarray; + my $cwd = abs_path("."); + my $tempdir = tempdir($label); + + chdir $tempdir or die "Can't chdir to '$tempdir'"; + my (@ret); + my $ok = eval { + if ($wantarray) { + @ret = $code->($tempdir); + } + elsif ( defined $wantarray ) { + $ret[0] = $code->($tempdir); + } + else { + $code->($tempdir); + } + 1; + }; + my $err = $@; + chdir $cwd or chdir "/" or die "Can't chdir to either '$cwd' or '/'"; + die $err if !$ok; + return $wantarray ? @ret : $ret[0]; +} + +sub _inside_t_dir { + -d "../t" && abs_path(".") eq abs_path("../t"); +} + +sub _init { + + my $DEFAULT_ROOT = catdir( $ORIGINAL_CWD, "tmp" ); + + if ( -d 't' && ( -w $DEFAULT_ROOT || -w '.' ) ) { + $ROOT_DIR = $DEFAULT_ROOT; + } + elsif ( _inside_t_dir() && ( -w '../$DEFAULT_ROOT' || -w '..' ) ) { + $ROOT_DIR = catdir( $ORIGINAL_CWD, "..", "tmp" ); + } + else { + $ROOT_DIR = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 ); + $SYSTEM_TEMP = 1; + } + + # TEST_DIR is based on .t path under ROOT_DIR + ( my $dirname = $0 ) =~ tr{:\\/.}{_}; + $TEST_DIR = catdir( $ROOT_DIR, $dirname ); + + # If it exists from a previous run, clear it out + if ( -d $TEST_DIR ) { + remove_tree( $TEST_DIR, { safe => 0, keep_root => 1 } ); + return; + } + + # Need to create directory, but constructing nested directories can never + # be atomic, so we have to retry if the tempdir root gets deleted out from + # under us (perhaps by a parallel test) + + for my $n ( 1 .. $TRIES ) { + # Failing to mkdir is OK as long as error is EEXIST + if ( !mkdir($ROOT_DIR) ) { + confess("Couldn't create $ROOT_DIR: $!") + unless $! == EEXIST; + } + + # Normalize after we know it exists, because abs_path might fail on + # some platforms if it doesn't exist + $ROOT_DIR = abs_path($ROOT_DIR); + + # If mkdir succeeds, we're done + if ( mkdir $TEST_DIR ) { + # similarly normalize only after we're sure it exists + $TEST_DIR = abs_path($TEST_DIR); + return; + } + + # Anything other than ENOENT is a real error + if ( $! != ENOENT ) { + confess("Couldn't create $TEST_DIR: $!"); + } + + # ENOENT means $ROOT_DIR was removed from under us or is not a + # directory. Only the latter case is a real error. + if ( -e $ROOT_DIR && !-d _ ) { + confess("$ROOT_DIR is not a directory"); + } + + select( undef, undef, undef, $DELAY ) if $n < $TRIES; + } + + warn "Couldn't create $TEST_DIR in $TRIES tries.\n" + . "Using a regular tempdir instead.\n"; + + # Because fallback isn't under root, we let File::Temp clean it up. + $TEST_DIR = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 ); + return; +} + +sub _cleanup { + return if $ENV{PERL_TEST_TEMPDIR_TINY_NOCLEANUP}; + if ( $ROOT_DIR && -d $ROOT_DIR ) { + # always cleanup if root is in system temp directory, otherwise + # only clean up if exiting with non-zero value + if ( $SYSTEM_TEMP or not $? ) { + chdir $ORIGINAL_CWD + or chdir "/" + or warn "Can't chdir to '$ORIGINAL_CWD' or '/'. Cleanup might fail."; + remove_tree( $TEST_DIR, { safe => 0 } ) + if -d $TEST_DIR; + } + + # Remove root unless it's a symlink, which a user might create to + # force it to another drive. Removal will fail if there are any + # children, but we ignore errors as other tests might be running + # in parallel and have tempdirs there. + rmdir $ROOT_DIR unless -l $ROOT_DIR; + } +} + +# for testing +sub _root_dir { return $ROOT_DIR } + +END { + # only clean up in original process, not children + if ( $$ == $ORIGINAL_PID ) { + # our clean up must run after Test::More sets $? in its END block + require B; + push @{ B::end_av()->object_2svref }, \&_cleanup; + } +} + +1; + +=head1 SYNOPSIS + + # t/foo.t + use Test::More; + use Test::TempDir::Tiny; + + # default tempdirs + $dir = tempdir(); # ./tmp/t_foo_t/default_1/ + $dir = tempdir(); # ./tmp/t_foo_t/default_2/ + + # labeled tempdirs + $dir = tempdir("label"); # ./tmp/t_foo_t/label_1/ + $dir = tempdir("label"); # ./tmp/t_foo_t/label_2/ + + # labels with spaces and non-word characters + $dir = tempdir("bar baz") # ./tmp/t_foo_t/bar_baz_1/ + $dir = tempdir("!!!bang") # ./tmp/t_foo_t/_bang_1/ + + # run code in a temporary directory + in_tempdir "label becomes name" => sub { + my $cwd = shift; + # do stuff in a tempdir + }; + +=head1 DESCRIPTION + +This module works with L to create temporary directories that stick +around if tests fail. + +It is loosely based on L, but with less complexity, greater +portability and zero non-core dependencies. (L is recommended +for testing.) + +The L and L functions are exported by default. + +If the current directory is writable, the root for directories will be +F<./tmp>. Otherwise, a L directory will be created wherever +temporary directories are stored for your system. + +Every F<*.t> file gets its own subdirectory under the root based on the test +filename, but with slashes and periods replaced with underscores. For example, +F would get a test-file-specific subdirectory F<./tmp/t_foo_t/>. +Directories created by L get put in that directory. This makes it +very easy to find files later if tests fail. + +The test-file-specific name is consistent from run-to-run. If an old directory +already exists, it will be removed. + +When the test file exits, if all tests passed, then the test-file-specific +directory is recursively removed. + +If a test failed and the root directory is F<./tmp>, the test-file-specific +directory sticks around for inspection. (But if the root is a L +directory, it is always discarded). + +If nothing is left in F<./tmp> (i.e. no other test file failed), then F<./tmp> +is cleaned up as well (unless it's a symlink). + +This module attempts to avoid race conditions due to parallel testing. In +extreme cases, the test-file-specific subdirectory might be created as a +regular L directory rather than in F<./tmp>. In such a case, +a warning will be issued. + +=head1 ENVIRONMENT + +=head2 C + +When this environment variable is true, directories will not be cleaned up, +even if tests pass. + +=head1 SEE ALSO + +=for :list +* L +* L + +=cut + +# vim: ts=4 sts=4 sw=4 et: From 61d5833f042f36b748b25760199ea846d4361fde Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Thu, 9 Jul 2015 13:13:32 +1200 Subject: [PATCH 2/6] Simplify unnecessary POD that wont get installed --- t/tlib/Test/TempDir/Tiny.pm | 139 ++---------------------------------- 1 file changed, 6 insertions(+), 133 deletions(-) diff --git a/t/tlib/Test/TempDir/Tiny.pm b/t/tlib/Test/TempDir/Tiny.pm index b91f64e..f4fd016 100644 --- a/t/tlib/Test/TempDir/Tiny.pm +++ b/t/tlib/Test/TempDir/Tiny.pm @@ -24,41 +24,8 @@ my ( $ROOT_DIR, $TEST_DIR, %COUNTER ); my ( $ORIGINAL_PID, $ORIGINAL_CWD, $TRIES, $DELAY, $SYSTEM_TEMP ) = ( $$, abs_path("."), 100, 50 / 1000, 0 ); -=func tempdir - - $dir = tempdir(); # .../default_1/ - $dir = tempdir("label"); # .../label_1/ - -Creates a directory underneath a test-file-specific temporary directory and -returns the absolute path to it in platform-native form (i.e. with backslashes -on Windows). - -The function takes a single argument as a label for the directory or defaults -to "default". An incremental counter value will be appended to allow a label to -be used within a loop with distinct temporary directories: - - # t/foo.t - - for ( 1 .. 3 ) { - tempdir("in loop"); - } - - # creates: - # ./tmp/t_foo_t/in_loop_1 - # ./tmp/t_foo_t/in_loop_2 - # ./tmp/t_foo_t/in_loop_3 - -If the label contains any characters besides alphanumerics, underscore -and dash, they will be collapsed and replaced with a single underscore. - - $dir = tempdir("a space"); # .../a_space_1/ - $dir = tempdir("a!bang"); # .../a_bang_1/ - -The test-file-specific directory and all directories within it will be cleaned -up with an END block if the current test file passes tests. - -=cut - +# $dir = tempdir(); # .../default_1/ +# $dir = tempdir("label"); # .../label_1/ sub tempdir { my $label = defined( $_[0] ) ? $_[0] : 'default'; $label =~ tr{a-zA-Z0-9_-}{_}cs; @@ -70,26 +37,10 @@ sub tempdir { return $subdir; } -=func in_tempdir - - in_tempdir "label becomes name" => sub { - my $cwd = shift; - # this happens in tempdir - }; - -Given a label and a code reference, creates a temporary directory based on the -label (following the rules of L), changes to that directory, runs the -code, then changes back to the original directory. - -The temporary directory path is given as an argument to the code reference. -The code runs in the same context as C and C returns -the return value(s) from the code. - -When the code finishes (even if it dies), C will change back to the -original directory if it can, to the root if it can't, and will rethrow any -fatal errors. - -=cut +# in_tempdir "label becomes name" => sub { +# my $cwd = shift; +# # this happens in tempdir +# }; sub in_tempdir { my ( $label, $code ) = @_; @@ -225,82 +176,4 @@ END { 1; -=head1 SYNOPSIS - - # t/foo.t - use Test::More; - use Test::TempDir::Tiny; - - # default tempdirs - $dir = tempdir(); # ./tmp/t_foo_t/default_1/ - $dir = tempdir(); # ./tmp/t_foo_t/default_2/ - - # labeled tempdirs - $dir = tempdir("label"); # ./tmp/t_foo_t/label_1/ - $dir = tempdir("label"); # ./tmp/t_foo_t/label_2/ - - # labels with spaces and non-word characters - $dir = tempdir("bar baz") # ./tmp/t_foo_t/bar_baz_1/ - $dir = tempdir("!!!bang") # ./tmp/t_foo_t/_bang_1/ - - # run code in a temporary directory - in_tempdir "label becomes name" => sub { - my $cwd = shift; - # do stuff in a tempdir - }; - -=head1 DESCRIPTION - -This module works with L to create temporary directories that stick -around if tests fail. - -It is loosely based on L, but with less complexity, greater -portability and zero non-core dependencies. (L is recommended -for testing.) - -The L and L functions are exported by default. - -If the current directory is writable, the root for directories will be -F<./tmp>. Otherwise, a L directory will be created wherever -temporary directories are stored for your system. - -Every F<*.t> file gets its own subdirectory under the root based on the test -filename, but with slashes and periods replaced with underscores. For example, -F would get a test-file-specific subdirectory F<./tmp/t_foo_t/>. -Directories created by L get put in that directory. This makes it -very easy to find files later if tests fail. - -The test-file-specific name is consistent from run-to-run. If an old directory -already exists, it will be removed. - -When the test file exits, if all tests passed, then the test-file-specific -directory is recursively removed. - -If a test failed and the root directory is F<./tmp>, the test-file-specific -directory sticks around for inspection. (But if the root is a L -directory, it is always discarded). - -If nothing is left in F<./tmp> (i.e. no other test file failed), then F<./tmp> -is cleaned up as well (unless it's a symlink). - -This module attempts to avoid race conditions due to parallel testing. In -extreme cases, the test-file-specific subdirectory might be created as a -regular L directory rather than in F<./tmp>. In such a case, -a warning will be issued. - -=head1 ENVIRONMENT - -=head2 C - -When this environment variable is true, directories will not be cleaned up, -even if tests pass. - -=head1 SEE ALSO - -=for :list -* L -* L - -=cut - # vim: ts=4 sts=4 sw=4 et: From f4e98f81b335d5e2ba7a195c32cf1befb0a5dbb1 Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Wed, 8 Jul 2015 18:13:57 +1200 Subject: [PATCH 3/6] Add tlib/ByteSlurper.pm for reading/reading files as bytestrings --- t/tlib/ByteSlurper.pm | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 t/tlib/ByteSlurper.pm diff --git a/t/tlib/ByteSlurper.pm b/t/tlib/ByteSlurper.pm new file mode 100644 index 0000000..2b3d45a --- /dev/null +++ b/t/tlib/ByteSlurper.pm @@ -0,0 +1,30 @@ +package ByteSlurper; + +# "Raw" was too vague, especially seeing its not :raw. +# ":unix" being how we get "Raw" is too confusing. +# ITS BYTES. + +use strict; +use warnings; + +use Carp 'croak'; +use Exporter; +*import = \&Exporter::import; + +our @EXPORT_OK = qw/read_bytes write_bytes/; + +sub read_bytes { + my ($filename) = @_; + open my $fh, "<:unix", $filename or croak "Couldn't open $filename: $!"; + return do { local $/; <$fh> }; +} + +sub write_bytes { + my ( $filename, undef ) = @_; + open my $fh, ">:unix", $filename or croak "Couldn't open $filename: $!"; + print $fh $_[1] or croak "Couldn't write to $filename: $!"; + close $fh or croak "Couldn't write to $filename: $!"; + return; +} + +1; From 91b879e212a699537a804f641a0a12af6d4627f3 Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Tue, 23 Jun 2015 13:15:10 +1200 Subject: [PATCH 4/6] Add mailmap to map kentnl's CPAN email address --- .mailmap | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 .mailmap diff --git a/.mailmap b/.mailmap new file mode 100644 index 0000000..6ae016e --- /dev/null +++ b/.mailmap @@ -0,0 +1,3 @@ +# https://www.kernel.org/pub/software/scm/git/docs/git-shortlog.html +# or git help shortlog +Kent Fredric From 02d3e018324a296abe8555c8978aab778d1ca735 Mon Sep 17 00:00:00 2001 From: Ed J Date: Sun, 10 May 2015 22:00:25 +0100 Subject: [PATCH 5/6] Doc, implement #!include_default as memory-only, not changing file. --- Changes | 1 + lib/ExtUtils/Manifest.pm | 48 ++++++++++++++++++++++++---------------- 2 files changed, 30 insertions(+), 19 deletions(-) diff --git a/Changes b/Changes index 0514d02..bd06d04 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,7 @@ Revision history for ExtUtils-Manifest {{$NEXT}} + - #!include_default now memory-only, not changing MANIFEST.SKIP file. 1.70 2014-12-31 - also skip _eumm, an artifact of ExtUtils::MakeMaker 7.05* diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index af0c00c..fa55a08 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -404,6 +404,20 @@ a given filename should be skipped. =cut +sub _process_skipline { + local $_ = shift; + chomp; + s/\r//; + $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$}; + #my $comment = $3; + my $filename = $2; + if ( defined($1) ) { + $filename = $1; + $filename =~ s/\\(['\\])/$1/g; + } + $filename; +} + # returns an anonymous sub that decides if an argument matches sub maniskip { my @skip ; @@ -412,16 +426,14 @@ sub maniskip { local(*M, $_); open M, "< $mfile" or open M, "< $DEFAULT_MSKIP" or return sub {0}; while (){ - chomp; - s/\r//; - $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$}; - #my $comment = $3; - my $filename = $2; - if ( defined($1) ) { - $filename = $1; - $filename =~ s/\\(['\\])/$1/g; + if (/^#!include_default\s*$/) { + if (my @default = _include_mskip_file()) { + warn "Debug: Including default MANIFEST.SKIP\n" if $Debug; + push @skip, grep $_, map _process_skipline($_), @default; + } + next; } - next if (not defined($filename) or not $filename); + next unless my $filename = _process_skipline($_); push @skip, _macify($filename); } close M; @@ -452,14 +464,6 @@ sub _check_mskip_directives { return; } while () { - if (/^#!include_default\s*$/) { - if (my @default = _include_mskip_file()) { - push @lines, @default; - warn "Debug: Including default MANIFEST.SKIP\n" if $Debug; - $flag++; - } - next; - } if (/^#!include\s+(.*)\s*$/) { my $external_file = $1; if (my @external = _include_mskip_file($external_file)) { @@ -809,11 +813,17 @@ files. At present two such directives are recognized. =item #!include_default -This inserts the contents of the default MANIFEST.SKIP file +This tells ExtUtils::Manifest to read the default F +file and skip files accordingly, but I to include it in the local +F. This is intended to skip files according to a system +default, which can change over time without requiring further changes +to the distribution's F. =item #!include /Path/to/another/manifest.skip -This inserts the contents of the specified external file +This inserts the contents of the specified external file in the local +F. This is intended for authors to have a central +F file, and to include it with their various distributions. =back From d55d35a11f99d1eb986baa93a925b297cd45a5cc Mon Sep 17 00:00:00 2001 From: Kent Fredric Date: Tue, 23 Jun 2015 13:42:32 +1200 Subject: [PATCH 6/6] Add isolated tests for Mohawks include-default patch --- t/maniskip.include-default.t | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 t/maniskip.include-default.t diff --git a/t/maniskip.include-default.t b/t/maniskip.include-default.t new file mode 100644 index 0000000..9f718a4 --- /dev/null +++ b/t/maniskip.include-default.t @@ -0,0 +1,26 @@ +use strict; +use warnings; + +use Test::More tests => 3; +use ExtUtils::Manifest qw( maniskip ); + +# ABSTRACT: Ensure include-default is memory only + +use lib 't/tlib'; +use Test::TempDir::Tiny qw( in_tempdir ); +use ByteSlurper qw( write_bytes read_bytes ); + +in_tempdir 'no-default-expansions' => sub { + + write_bytes( 'MANIFEST.SKIP', qq[#!include_default] ); + + my $skipchk = maniskip(); + + my $skipcontents = read_bytes('MANIFEST.SKIP'); + + unlike( $skipcontents, qr/#!start\s*included/, 'include_default not expanded on disk' ); + + ok( $skipchk->('Makefile'), 'Makefile still skipped by default' ); + ok( !$skipchk->('Makefile.PL'), 'Makefile.PL still not skipped by default' ); +}; +done_testing;