Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
Alien	[ DIR ]	drwxrwxrwx
Base	[ DIR ]	drwxrwxrwx
Deep	[ DIR ]	drwxrwxrwx
File	[ DIR ]	drwxrwxrwx
LeakTrace	[ DIR ]	drwxrwxrwx
NoWarnings	[ DIR ]	drwxrwxrwx
Number	[ DIR ]	drwxrwxrwx
Object	[ DIR ]	drwxrwxrwx
Without	[ DIR ]	drwxrwxrwx
Alien.pm	23.44 KB	-rw-rw-rw-
Base.pm	17.89 KB	-rw-rw-rw-
Base.pod	20.63 KB	-rw-rw-rw-
CleanNamespaces.pm	8.16 KB	-rw-rw-rw-
Deep.pm	48.95 KB	-rw-rw-rw-
Differences.pm	18.06 KB	-rw-rw-rw-
Exception.pm	15.1 KB	-rw-rw-rw-
FailWarnings.pm	5.32 KB	-rw-rw-rw-
Fatal.pm	11.04 KB	-rw-rw-rw-
File.pm	39.2 KB	-rw-rw-rw-
Fork.pm	4.01 KB	-rw-rw-rw-
LeakTrace.pm	7.09 KB	-rw-rw-rw-
MockTime.pm	6.49 KB	-rw-rw-rw-
Mojo.pm	33.89 KB	-rw-rw-rw-
Moose.pm	4.09 KB	-rw-rw-rw-
Needs.pm	8.05 KB	-rw-rw-rw-
NoWarnings.pm	7.44 KB	-rw-rw-rw-
Object.pm	4 KB	-rw-rw-rw-
Output.pm	21.9 KB	-rw-rw-rw-
Pod.pm	7.24 KB	-rw-rw-rw-
Requires.pm	3.6 KB	-rw-rw-rw-
RequiresInternet.pm	2.87 KB	-rw-rw-rw-
Script.pm	18.7 KB	-rw-rw-rw-
Specio.pm	40.38 KB	-rw-rw-rw-
SubCalls.pm	4.66 KB	-rw-rw-rw-
Warn.pm	15.52 KB	-rw-rw-rw-
Warnings.pm	14.29 KB	-rw-rw-rw-
YAML.pm	5.25 KB	-rw-rw-rw-
YAML.pod	710 B	-rw-rw-rw-
utf8.pm	10.44 KB	-rw-rw-rw-

Code Editor : Output.pm

package Test::Output;

use warnings;
use strict;

use Test::Builder;
use Capture::Tiny qw/capture capture_stdout capture_stderr capture_merged/;

use Exporter qw(import);

our %EXPORT_TAGS = (
	stdout => [
      qw(
        stdout_is stdout_isnt stdout_like stdout_unlike
        )
    ],
    stderr => [
      qw(
        stderr_is stderr_isnt stderr_like stderr_unlike
        )
    ],
    output => [
      qw(
        output_is output_isnt output_like output_unlike
        )
    ],
    combined => [
      qw(
        combined_is combined_isnt combined_like combined_unlike
        )
    ],
    functions => [
      qw(
        output_from stderr_from stdout_from combined_from
        )
    ],
    tests => [
      qw(
        output_is output_isnt output_like output_unlike
        stderr_is stderr_isnt stderr_like stderr_unlike
        stdout_is stdout_isnt stdout_like stdout_unlike
        combined_is combined_isnt combined_like combined_unlike
        )
    ],
    all => [
      qw(
        output_is output_isnt output_like output_unlike
        stderr_is stderr_isnt stderr_like stderr_unlike
        stdout_is stdout_isnt stdout_like stdout_unlike
        combined_is combined_isnt combined_like combined_unlike
        output_from stderr_from stdout_from combined_from
        )
    ],
	);

our @EXPORT = keys %{
		{
		map { $_ => 1 }
		map {
			@{ $EXPORT_TAGS{$_} }
			}
		keys %EXPORT_TAGS
		}
	};

my $Test = Test::Builder->new;

=encoding utf8

=head1 NAME

Test::Output - Utilities to test STDOUT and STDERR messages.

=cut

our $VERSION = '1.031';

=head1 SYNOPSIS

use Test::More tests => 4;
    use Test::Output;

sub writer {
      print "Write out.\n";
      print STDERR "Error out.\n";
    }

stdout_is(\&writer,"Write out.\n",'Test STDOUT');

stderr_isnt(\&writer,"No error out.\n",'Test STDERR');

combined_is(
                \&writer,
                "Write out.\nError out.\n",
                'Test STDOUT & STDERR combined'
               );

output_is(
              \&writer,
              "Write out.\n",
              "Error out.\n",
              'Test STDOUT & STDERR'
            );

# Use bare blocks.

stdout_is { print "test" } "test", "Test STDOUT";
   stderr_isnt { print "bad test" } "test", "Test STDERR";
   output_is { print 'STDOUT'; print STDERR 'STDERR' }
     "STDOUT", "STDERR", "Test output";

=head1 DESCRIPTION

Test::Output provides a simple interface for testing output sent to C<STDOUT>
or C<STDERR>. A number of different utilities are included to try and be as
flexible as possible to the tester.

Likewise, L<Capture::Tiny> provides a much more robust capture mechanism without
than the original L<Test::Output::Tie>.

=cut

=head1 TESTS

=cut

=head2 STDOUT

=over 4

=item B<stdout_is>

=item B<stdout_isnt>

stdout_is  ( $coderef, $expected, 'description' );
   stdout_is    { ... } $expected, 'description';
   stdout_isnt( $coderef, $expected, 'description' );
   stdout_isnt  { ... } $expected, 'description';

C<stdout_is()> captures output sent to C<STDOUT> from C<$coderef> and compares
it against C<$expected>. The test passes if equal.

C<stdout_isnt()> passes if C<STDOUT> is not equal to C<$expected>.

=cut

sub stdout_is (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my $stdout = stdout_from($test);

my $ok = ( $stdout eq $expected );

$Test->ok( $ok, $description )
    || $Test->diag("STDOUT is:\n$stdout\nnot:\n$expected\nas expected");

return $ok;
}

sub stdout_isnt (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my $stdout = stdout_from($test);

my $ok = ( $stdout ne $expected );

$Test->ok( $ok, $description )
    || $Test->diag("STDOUT:\n$stdout\nmatching:\n$expected\nnot expected");

return $ok;
}

=item B<stdout_like>

=item B<stdout_unlike>

stdout_like  ( $coderef, qr/$expected/, 'description' );
   stdout_like    { ... } qr/$expected/, 'description';
   stdout_unlike( $coderef, qr/$expected/, 'description' );
   stdout_unlike  { ... } qr/$expected/, 'description';

C<stdout_like()> captures the output sent to C<STDOUT> from C<$coderef> and compares
it to the regex in C<$expected>. The test passes if the regex matches.

C<stdout_unlike()> passes if STDOUT does not match the regex.

=back

=cut

sub stdout_like (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

unless ( my $regextest = _chkregex( 'stdout_like' => $expected ) ) {
    return $regextest;
  }

my $stdout = stdout_from($test);

my $ok = ( $stdout =~ $expected );

$Test->ok( $ok, $description )
    || $Test->diag("STDOUT:\n$stdout\ndoesn't match:\n$expected\nas expected");

return $ok;
}

sub stdout_unlike (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

unless ( my $regextest = _chkregex( 'stdout_unlike' => $expected ) ) {
    return $regextest;
  }

my $stdout = stdout_from($test);

my $ok = ( $stdout !~ $expected );

$Test->ok( $ok, $description )
    || $Test->diag("STDOUT:\n$stdout\nmatches:\n$expected\nnot expected");

return $ok;
}

=head2 STDERR

=over 4

=item B<stderr_is>

=item B<stderr_isnt>

stderr_is  ( $coderef, $expected, 'description' );
   stderr_is    {... } $expected, 'description';

stderr_isnt( $coderef, $expected, 'description' );
   stderr_isnt  {... } $expected, 'description';

C<stderr_is()> is similar to C<stdout_is>, except that it captures C<STDERR>. The
test passes if C<STDERR> from C<$coderef> equals C<$expected>.

C<stderr_isnt()> passes if C<STDERR> is not equal to C<$expected>.

=cut

sub stderr_is (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my $stderr = stderr_from($test);

my $ok = ( $stderr eq $expected );

$Test->ok( $ok, $description )
    || $Test->diag("STDERR is:\n$stderr\nnot:\n$expected\nas expected");

return $ok;
}

sub stderr_isnt (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my $stderr = stderr_from($test);

my $ok = ( $stderr ne $expected );

$Test->ok( $ok, $description )
    || $Test->diag("STDERR:\n$stderr\nmatches:\n$expected\nnot expected");

return $ok;
}

=item B<stderr_like>

=item B<stderr_unlike>

stderr_like  ( $coderef, qr/$expected/, 'description' );
   stderr_like   { ...} qr/$expected/, 'description';
   stderr_unlike( $coderef, qr/$expected/, 'description' );
   stderr_unlike  { ...} qr/$expected/, 'description';

C<stderr_like()> is similar to C<stdout_like()> except that it compares the regex
C<$expected> to C<STDERR> captured from C<$codref>. The test passes if the regex
matches.

C<stderr_unlike()> passes if C<STDERR> does not match the regex.

=back

=cut

sub stderr_like (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

unless ( my $regextest = _chkregex( 'stderr_like' => $expected ) ) {
    return $regextest;
  }

my $stderr = stderr_from($test);

my $ok = ( $stderr =~ $expected );

$Test->ok( $ok, $description )
    || $Test->diag("STDERR:\n$stderr\ndoesn't match:\n$expected\nas expected");

return $ok;
}

sub stderr_unlike (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

unless ( my $regextest = _chkregex( 'stderr_unlike' => $expected ) ) {
    return $regextest;
  }

my $stderr = stderr_from($test);

my $ok = ( $stderr !~ $expected );

$Test->ok( $ok, $description )
    || $Test->diag("STDERR:\n$stderr\nmatches:\n$expected\nnot expected");

return $ok;
}

=head2 COMBINED OUTPUT

=over 4

=item B<combined_is>

=item B<combined_isnt>

combined_is   ( $coderef, $expected, 'description' );
   combined_is   {... } $expected, 'description';
   combined_isnt ( $coderef, $expected, 'description' );
   combined_isnt {... } $expected, 'description';

C<combined_is()> directs C<STDERR> to C<STDOUT> then captures C<STDOUT>. This is
equivalent to UNIXs C<< 2>&1 >>. The test passes if the combined C<STDOUT>
and C<STDERR> from $coderef equals $expected.

C<combined_isnt()> passes if combined C<STDOUT> and C<STDERR> are not equal
to C<$expected>.

=cut

sub combined_is (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my $combined = combined_from($test);

my $ok = ( $combined eq $expected );

$Test->ok( $ok, $description )
    || $Test->diag(
    "STDOUT & STDERR are:\n$combined\nnot:\n$expected\nas expected");

return $ok;
}

sub combined_isnt (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my $combined = combined_from($test);

my $ok = ( $combined ne $expected );

$Test->ok( $ok, $description )
    || $Test->diag(
    "STDOUT & STDERR:\n$combined\nmatching:\n$expected\nnot expected");

return $ok;
}

=item B<combined_like>

=item B<combined_unlike>

combined_like   ( $coderef, qr/$expected/, 'description' );
   combined_like   { ...} qr/$expected/, 'description';
   combined_unlike ( $coderef, qr/$expected/, 'description' );
   combined_unlike { ...} qr/$expected/, 'description';

C<combined_like()> is similar to C<combined_is()> except that it compares a regex
(C<$expected)> to C<STDOUT> and C<STDERR> captured from C<$codref>. The test passes if
the regex matches.

C<combined_unlike()> passes if the combined C<STDOUT> and C<STDERR> does not match
the regex.

=back

=cut

sub combined_like (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

unless ( my $regextest = _chkregex( 'combined_like' => $expected ) ) {
    return $regextest;
  }

my $combined = combined_from($test);

my $ok = ( $combined =~ $expected );

$Test->ok( $ok, $description )
    || $Test->diag(
    "STDOUT & STDERR:\n$combined\ndon't match:\n$expected\nas expected");

return $ok;
}

sub combined_unlike (&$;$$) {
  my $test        = shift;
  my $expected    = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

unless ( my $regextest = _chkregex( 'combined_unlike' => $expected ) ) {
    return $regextest;
  }

my $combined = combined_from($test);

my $ok = ( $combined !~ $expected );

$Test->ok( $ok, $description )
    || $Test->diag(
    "STDOUT & STDERR:\n$combined\nmatching:\n$expected\nnot expected");

return $ok;
}

=head2 OUTPUT

=over 4

=item B<output_is>

=item B<output_isnt>

output_is  ( $coderef, $expected_stdout, $expected_stderr, 'description' );
   output_is    {... } $expected_stdout, $expected_stderr, 'description';
   output_isnt( $coderef, $expected_stdout, $expected_stderr, 'description' );
   output_isnt  {... } $expected_stdout, $expected_stderr, 'description';

The C<output_is()> function is a combination of the C<stdout_is()> and C<stderr_is()>
functions. For example:

output_is(sub {print "foo"; print STDERR "bar";},'foo','bar');

is functionally equivalent to

stdout_is(sub {print "foo";},'foo')
    && stderr_is(sub {print STDERR "bar";'bar');

except that C<$coderef> is only executed once.

Unlike C<stdout_is()> and C<stderr_is()> which ignore STDERR and STDOUT
respectively, C<output_is()> requires both C<STDOUT> and C<STDERR> to match in order
to pass. Setting either C<$expected_stdout> or C<$expected_stderr> to C<undef>
ignores C<STDOUT> or C<STDERR> respectively.

output_is(sub {print "foo"; print STDERR "bar";},'foo',undef);

is the same as

stdout_is(sub {print "foo";},'foo')

C<output_isnt()> provides the opposite function of C<output_is()>. It is a
combination of C<stdout_isnt()> and C<stderr_isnt()>.

output_isnt(sub {print "foo"; print STDERR "bar";},'bar','foo');

is functionally equivalent to

stdout_is(sub {print "foo";},'bar')
    && stderr_is(sub {print STDERR "bar";'foo');

As with C<output_is()>, setting either C<$expected_stdout> or C<$expected_stderr> to
C<undef> ignores the output to that facility.

output_isnt(sub {print "foo"; print STDERR "bar";},undef,'foo');

is the same as

stderr_is(sub {print STDERR "bar";},'foo')

=cut

sub output_is (&$$;$$) {
  my $test        = shift;
  my $expout      = shift;
  my $experr      = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my ( $stdout, $stderr ) = output_from($test);

my $ok = 1;
  my $diag;

if ( defined($experr) && defined($expout) ) {
    unless ( $stdout eq $expout ) {
      $ok = 0;
      $diag .= "STDOUT is:\n$stdout\nnot:\n$expout\nas expected";
    }
    unless ( $stderr eq $experr ) {
      $diag .= "\n" unless ($ok);
      $ok = 0;
      $diag .= "STDERR is:\n$stderr\nnot:\n$experr\nas expected";
    }
  }
  elsif ( defined($expout) ) {
    $ok = ( $stdout eq $expout );
    $diag .= "STDOUT is:\n$stdout\nnot:\n$expout\nas expected";
  }
  elsif ( defined($experr) ) {
    $ok = ( $stderr eq $experr );
    $diag .= "STDERR is:\n$stderr\nnot:\n$experr\nas expected";
  }
  else {
    unless ( $stdout eq '' ) {
      $ok = 0;
      $diag .= "STDOUT is:\n$stdout\nnot:\n\nas expected";
    }
    unless ( $stderr eq '' ) {
      $diag .= "\n" unless ($ok);
      $ok = 0;
      $diag .= "STDERR is:\n$stderr\nnot:\n\nas expected";
    }
  }

$Test->ok( $ok, $description ) || $Test->diag($diag);

return $ok;
}

sub output_isnt (&$$;$$) {
  my $test        = shift;
  my $expout      = shift;
  my $experr      = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my ( $stdout, $stderr ) = output_from($test);

my $ok = 1;
  my $diag;

if ( defined($experr) && defined($expout) ) {
    if ( $stdout eq $expout ) {
      $ok = 0;
      $diag .= "STDOUT:\n$stdout\nmatching:\n$expout\nnot expected";
    }
    if ( $stderr eq $experr ) {
      $diag .= "\n" unless ($ok);
      $ok = 0;
      $diag .= "STDERR:\n$stderr\nmatching:\n$experr\nnot expected";
    }
  }
  elsif ( defined($expout) ) {
    $ok = ( $stdout ne $expout );
    $diag = "STDOUT:\n$stdout\nmatching:\n$expout\nnot expected";
  }
  elsif ( defined($experr) ) {
    $ok = ( $stderr ne $experr );
    $diag = "STDERR:\n$stderr\nmatching:\n$experr\nnot expected";
  }
  else {
    if ( $stdout eq '' ) {
      $ok   = 0;
      $diag = "STDOUT:\n$stdout\nmatching:\n\nnot expected";
    }
    if ( $stderr eq '' ) {
      $diag .= "\n" unless ($ok);
      $ok = 0;
      $diag .= "STDERR:\n$stderr\nmatching:\n\nnot expected";
    }
  }

$Test->ok( $ok, $description ) || $Test->diag($diag);

return $ok;
}

=item B<output_like>

=item B<output_unlike>

output_like  ( $coderef, $regex_stdout, $regex_stderr, 'description' );
  output_like  { ... } $regex_stdout, $regex_stderr, 'description';
  output_unlike( $coderef, $regex_stdout, $regex_stderr, 'description' );
  output_unlike { ... } $regex_stdout, $regex_stderr, 'description';

C<output_like()> and C<output_unlike()> follow the same principles as C<output_is()>
and C<output_isnt()> except they use a regular expression for matching.

C<output_like()> attempts to match C<$regex_stdout> and C<$regex_stderr> against
C<STDOUT> and C<STDERR> produced by $coderef. The test passes if both match.

output_like(sub {print "foo"; print STDERR "bar";},qr/foo/,qr/bar/);

The above test is successful.

Like C<output_is()>, setting either C<$regex_stdout> or C<$regex_stderr> to
C<undef> ignores the output to that facility.

output_like(sub {print "foo"; print STDERR "bar";},qr/foo/,undef);

is the same as

stdout_like(sub {print "foo"; print STDERR "bar";},qr/foo/);

C<output_unlike()> test pass if output from C<$coderef> doesn't match
C<$regex_stdout> and C<$regex_stderr>.

=back

=cut

sub output_like (&$$;$$) {
  my $test        = shift;
  my $expout      = shift;
  my $experr      = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my ( $stdout, $stderr ) = output_from($test);

my $ok = 1;

unless (
    my $regextest = _chkregex(
      'output_like_STDERR' => $experr,
      'output_like_STDOUT' => $expout
    )
    )
  {
    return $regextest;
  }

my $diag;
  if ( defined($experr) && defined($expout) ) {
    unless ( $stdout =~ $expout ) {
      $ok = 0;
      $diag .= "STDOUT:\n$stdout\ndoesn't match:\n$expout\nas expected";
    }
    unless ( $stderr =~ $experr ) {
      $diag .= "\n" unless ($ok);
      $ok = 0;
      $diag .= "STDERR:\n$stderr\ndoesn't match:\n$experr\nas expected";
    }
  }
  elsif ( defined($expout) ) {
    $ok = ( $stdout =~ $expout );
    $diag .= "STDOUT:\n$stdout\ndoesn't match:\n$expout\nas expected";
  }
  elsif ( defined($experr) ) {
    $ok = ( $stderr =~ $experr );
    $diag .= "STDERR:\n$stderr\ndoesn't match:\n$experr\nas expected";
  }
  else {
    unless ( $stdout eq '' ) {
      $ok = 0;
      $diag .= "STDOUT is:\n$stdout\nnot:\n\nas expected";
    }
    unless ( $stderr eq '' ) {
      $diag .= "\n" unless ($ok);
      $ok = 0;
      $diag .= "STDERR is:\n$stderr\nnot:\n\nas expected";
    }
  }

$Test->ok( $ok, $description ) || $Test->diag($diag);

return $ok;
}

sub output_unlike (&$$;$$) {
  my $test        = shift;
  my $expout      = shift;
  my $experr      = shift;
  my $options     = shift if ( ref( $_[0] ) );
  my $description = shift;

my ( $stdout, $stderr ) = output_from($test);

my $ok = 1;

unless (
    my $regextest = _chkregex(
      'output_unlike_STDERR' => $experr,
      'output_unlike_STDOUT' => $expout
    )
    )
  {
    return $regextest;
  }

my $diag;
  if ( defined($experr) && defined($expout) ) {
    if ( $stdout =~ $expout ) {
      $ok = 0;
      $diag .= "STDOUT:\n$stdout\nmatches:\n$expout\nnot expected";
    }
    if ( $stderr =~ $experr ) {
      $diag .= "\n" unless ($ok);
      $ok = 0;
      $diag .= "STDERR:\n$stderr\nmatches:\n$experr\nnot expected";
    }
  }
  elsif ( defined($expout) ) {
    $ok = ( $stdout !~ $expout );
    $diag .= "STDOUT:\n$stdout\nmatches:\n$expout\nnot expected";
  }
  elsif ( defined($experr) ) {
    $ok = ( $stderr !~ $experr );
    $diag .= "STDERR:\n$stderr\nmatches:\n$experr\nnot expected";
  }

$Test->ok( $ok, $description ) || $Test->diag($diag);

return $ok;
}

=head1 EXPORTS

By default, all subroutines are exported by default.

=over 4

=item * :stdout - the subs with C<stdout> in the name.

=item * :stderr - the subs with C<stderr> in the name.

=item * :functions - the subs with C<_from> at the end.

=item * :output - the subs with C<output> in the name.

=item * :combined - the subs with C<combined> in the name.

=item * :tests - everything that outputs TAP

=item * :all - everything (which is the same as the default)

=back

=head1 FUNCTIONS

=cut

=head2 stdout_from

my $stdout = stdout_from($coderef)
  my $stdout = stdout_from { ... };

stdout_from() executes $coderef and captures STDOUT.

=cut

sub stdout_from (&) {
  my $test = shift;

my $stdout = capture_stdout {
    select( ( select(STDOUT), $| = 1 )[0] );
    $test->()
  };

return $stdout;
}

=head2 stderr_from

my $stderr = stderr_from($coderef)
  my $stderr = stderr_from { ... };

C<stderr_from()> executes C<$coderef> and captures C<STDERR>.

=cut

sub stderr_from (&) {
  my $test = shift;

# XXX why is this here and not in output_from or combined_from -- xdg, 2012-05-13
  local $SIG{__WARN__} = sub { print STDERR @_ }
    if $] < 5.008;

my $stderr = capture_stderr {
    select( ( select(STDERR), $| = 1 )[0] );
    $test->()
  };

return $stderr;
}

=head2 output_from

my ($stdout, $stderr) = output_from($coderef)
  my ($stdout, $stderr) = output_from {...};

C<output_from()> executes C<$coderef> one time capturing both C<STDOUT> and C<STDERR>.

=cut

sub output_from (&) {
  my $test = shift;

my ($stdout, $stderr) = capture {
    select( ( select(STDOUT), $| = 1 )[0] );
    select( ( select(STDERR), $| = 1 )[0] );
    $test->();
  };

return ( $stdout, $stderr );
}

=head2 combined_from

my $combined = combined_from($coderef);
  my $combined = combined_from {...};

C<combined_from()> executes C<$coderef> one time combines C<STDOUT> and C<STDERR>, and
captures them. C<combined_from()> is equivalent to using C<< 2>&1 >> in UNIX.

=cut

sub combined_from (&) {
  my $test = shift;

my $combined = capture_merged {
    select( ( select(STDOUT), $| = 1 )[0] );
    select( ( select(STDERR), $| = 1 )[0] );
    $test->();
  };

return $combined;
}

sub _chkregex {
  my %regexs = @_;

foreach my $test ( keys(%regexs) ) {
    next unless ( defined( $regexs{$test} ) );

my $usable_regex = $Test->maybe_regex( $regexs{$test} );
    unless ( defined($usable_regex) ) {
      my $ok = $Test->ok( 0, $test );

$Test->diag("'$regexs{$test}' doesn't look much like a regex to me.");
#       unless $ok;

return $ok;
    }
  }
  return 1;
}

=head1 AUTHOR

Currently maintained by brian d foy, C<bdfoy@cpan.org>.

Shawn Sorichetti, C<< <ssoriche@cpan.org> >>

=head1 SOURCE AVAILABILITY

This module is in Github:

http://github.com/briandfoy/test-output/tree/master

=head1 BUGS

Please report any bugs or feature requests to
C<bug-test-output@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.  I will be notified, and then you'll automatically
be notified of progress on your bug as I make changes.

=head1 ACKNOWLEDGEMENTS

Thanks to chromatic whose TieOut.pm was the basis for capturing output.

Also thanks to rjbs for his help cleaning the documentation, and pushing me to
L<Sub::Exporter>. (This feature has been removed since it uses none of
L<Sub::Exporter>'s strengths).

Thanks to David Wheeler for providing code block support and tests.

Thanks to Michael G Schwern for the solution to combining C<STDOUT> and C<STDERR>.

=head1 COPYRIGHT & LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;    # End of Test::Output

${this.title}

Code Editor : Output.pm