Add capture feature

[perl/modules/VPIT-TestHelpers.git] / t / 31-capture.t

diff --git a/t/31-capture.t b/t/31-capture.t
new file mode 100644 (file)
index 0000000..d211c99
--- /dev/null
+++ b/t/31-capture.t
@@ -0,0 +1,137 @@
+#!perl
+
+use strict;
+use warnings;
+
+use VPIT::TestHelpers 'capture';
+
+use Test::More tests => (4 + 4 * 2 + 2) * 4;
+
+my $long_length = 32 * 4096;
+
+sub hexdump {
+ my $s = $_[0];
+ $s =~ s/([^ a-zA-Z0-9_-])/sprintf '\x{%0*X}', (ord($1) <= 0xFF ? 2 : 4), ord $1/eg;
+ return $s;
+}
+
+my @tests = (
+ {
+  desc   => 'STDOUT only',
+  cmd    => [ $^X, '-e', 'print STDOUT qq[hello\n]' ],
+  expect => {
+   status => 0,
+   out    => "hello\n",
+   err    => '',
+  },
+ },
+ {
+  desc   => 'STDERR only',
+  cmd    => [ $^X, '-e', 'print STDERR qq[hi\n]' ],
+  expect => {
+   status => 0,
+   out    => '',
+   err    => "hi\n",
+  },
+ },
+ {
+  desc   => 'STDOUT+STDERR',
+  cmd    => [ $^X, '-e', 'print STDOUT qq[sup\n]; print STDERR qq[yo\n]' ],
+  expect => {
+   status => 0,
+   out    => "sup\n",
+   err    => "yo\n",
+  },
+ },
+ {
+  desc   => 'long',
+  cmd    => [ $^X, '-e', "sleep 1; print STDOUT q[a] x $long_length; sleep 1; print STDERR q[b] x $long_length; sleep 1; print STDOUT q[c] x $long_length" ],
+  expect => {
+   status => 0,
+   out    => ('a' x $long_length) . ('c' x $long_length),
+   err    => ('b' x $long_length),
+  },
+ },
+);
+
+for my $eol_spec (qw<0D 0A 0D0A 0A0D>) {
+ (my $eol = $eol_spec) =~ s/(..)/\\x{$1}/g;
+
+ my $eol_exp;
+ {
+  local $@;
+  $eol_exp = eval qq["$eol"];
+  die $@ if $@;
+ }
+ push @tests, {
+  desc   => "End of line $eol",
+  cmd    => [ $^X, '-e', "print STDOUT qq[out$eol]; print STDERR qq[err$eol]" ],
+  expect => {
+   status => 0,
+   out    => "out$eol_exp",
+   err    => "err$eol_exp",
+  },
+  hexcmp  => 1,
+ };
+
+ my $eol_bin_exp = ($^O eq 'MSWin32' && $eol_spec eq '0D0A')
+                   ? chr 0x0A : $eol_exp;
+ push @tests, {
+  desc   => "End of line $eol (binary mode)",
+  cmd    => [ $^X, '-e', "binmode *STDOUT; print STDOUT qq[out$eol]; binmode *STDERR; print STDERR qq[err$eol]" ],
+  expect => {
+   status => 0,
+   out    => "out$eol_bin_exp",
+   err    => "err$eol_bin_exp",
+  },
+  hexcmp  => 1,
+ };
+}
+
+push @tests, {
+ desc   => 'Non-existent',
+ cmd    => [ 'nonexistentexecutable' ],
+ expect => {
+  status => undef,
+  out    => qr/open3.*exec.*failed/,
+  err    => undef,
+ },
+};
+
+push @tests, {
+ desc   => 'Exception',
+ cmd    => [ $^X, '-e', 'die q[carrot]' ],
+ expect => {
+  status => 255 << 8,
+  out    => '',
+  err    => qr/carrot at -e/,
+ },
+};
+
+for my $test (@tests) {
+ my $desc     = $test->{desc};
+ my $expected = $test->{expect};
+
+ local $@;
+ my ($status, $out, $err) = eval { capture @{ $test->{cmd} } };
+
+ is $@,      '',                  "$desc: did not croak";
+ is $status, $expected->{status}, "$desc: status";
+
+ my ($exp_out, $exp_err) = @$expected{qw<out err>};
+ if ($test->{hexcmp}) {
+  $_       = hexdump($_)       for $out, $err;
+  $exp_out = hexdump($exp_out) unless ref $exp_out;
+  $exp_err = hexdump($exp_err) unless ref $exp_err;
+ }
+ if (ref $exp_out) {
+  like $out, $exp_out, "$desc: out";
+ } else {
+  is   $out, $exp_out, "$desc: out";
+ }
+ if (ref $exp_err) {
+  like $err, $exp_err, "$desc: err";
+ } else {
+  is   $err, $exp_err, "$desc: err";
+ }
+}