Created
September 19, 2013 01:57
-
-
Save dagolden/6618205 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
use warnings; | |
# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.026 | |
use Test::More tests => 6 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); | |
my @module_files = ( | |
'Meerkat.pm', 'Meerkat/Collection.pm', | |
'Meerkat/Cursor.pm', 'Meerkat/DateTime.pm', | |
'Meerkat/Role/Document.pm', 'Meerkat/Types.pm' | |
); | |
# fake home for cpan-testers | |
use File::Temp; | |
local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); | |
my @warnings; | |
for my $lib (@module_files) { | |
my ( $stdout, $stderr, $ec ) = _capture( | |
sub { | |
system( $^X, '-Mblib', '-e', "require q[$lib]" ); | |
} | |
); | |
is( $ec >> 8, 0, "$lib loaded ok" ); | |
if ( my @_warnings = split /\n/, $stderr ) { | |
warn @_warnings; | |
push @warnings, @_warnings; | |
} | |
} | |
is( scalar(@warnings), 0, 'no warnings found' ) if $ENV{AUTHOR_TESTING}; | |
#--------------------------------------------------------------------------# | |
# Capture::Tinier | |
#--------------------------------------------------------------------------# | |
my $IS_WIN32 = $^O eq 'MSWin32'; | |
sub _open { | |
open $_[0], $_[1] or Carp::confess "Error from open(" . join( q{, }, @_ ) . "): $!"; | |
} | |
sub _close { | |
close $_[0] or Carp::confess "Error from close(" . join( q{, }, @_ ) . "): $!"; | |
} | |
sub _copy_std { | |
my %handles; | |
for my $h (qw/stdout stderr stdin/) { | |
next if $h eq 'stdin' && !$IS_WIN32; # WIN32 hangs on tee without STDIN copied | |
my $redir = $h eq 'stdin' ? "<&" : ">&"; | |
_open $handles{$h} = IO::Handle->new(), $redir . uc($h); # ">&STDOUT" or "<&STDIN" | |
} | |
return \%handles; | |
} | |
# In some cases we open all (prior to forking) and in others we only open | |
# the output handles (setting up redirection) | |
sub _open_std { | |
my ($handles) = @_; | |
_open \*STDIN, "<&" . fileno $handles->{stdin} if defined $handles->{stdin}; | |
_open \*STDOUT, ">&" . fileno $handles->{stdout} if defined $handles->{stdout}; | |
_open \*STDERR, ">&" . fileno $handles->{stderr} if defined $handles->{stderr}; | |
} | |
sub _slurp { | |
my ( $name, $stash ) = @_; | |
my $fh = $stash->{new}{$name}; | |
seek( $fh, 0, 0 ) or die "Couldn't seek on capture handle for $name\n"; | |
my $text = do { local $/; scalar readline $fh }; | |
return defined($text) ? $text : ""; | |
} | |
sub _capture { | |
my ($code) = @_; | |
my $stash; | |
$stash->{old} = _copy_std(); | |
$stash->{new} = { %{ $stash->{old} } }; # default to originals | |
for (qw/stdout stderr/) { | |
$stash->{new}{$_} = File::Temp->new; | |
} | |
_open_std( $stash->{new} ); | |
my ( $exit_code, $inner_error, $outer_error, @result ); | |
{ | |
local $@; | |
eval { @result = $code->(); $inner_error = $@ }; | |
$exit_code = $?; # save this for later | |
$outer_error = $@; # save this for later | |
} | |
_open_std( $stash->{old} ); | |
_close($_) for values %{ $stash->{old} }; # don't leak fds | |
my %got; | |
for (qw/stdout stderr/) { | |
$got{$_} = _slurp( $_, $stash ); | |
} | |
$? = $exit_code; | |
$@ = $inner_error if $inner_error; | |
die $outer_error if $outer_error; | |
return ( $got{stdout}, $got{stderr}, @result ); | |
} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment