t/31-capture.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use VPIT::TestHelpers 'capture';
   7
   8 use Test::More tests => (4 + 4 * 2 + 2) * 4;
   9
  10 my $long_length = 32 * 4096;
  11
  12 sub hexdump {
  13  my $s = $_[0];
  14  $s =~ s/([^ a-zA-Z0-9_-])/sprintf '\x{%0*X}', (ord($1) <= 0xFF ? 2 : 4), ord $1/eg;
  15  return $s;
  16 }
  17
  18 my @tests = (
  19  {
  20   desc   => 'STDOUT only',
  21   cmd    => [ $^X, '-e', 'print STDOUT qq[hello\n]' ],
  22   expect => {
  23    status => 0,
  24    out    => "hello\n",
  25    err    => '',
  26   },
  27  },
  28  {
  29   desc   => 'STDERR only',
  30   cmd    => [ $^X, '-e', 'print STDERR qq[hi\n]' ],
  31   expect => {
  32    status => 0,
  33    out    => '',
  34    err    => "hi\n",
  35   },
  36  },
  37  {
  38   desc   => 'STDOUT+STDERR',
  39   cmd    => [ $^X, '-e', 'print STDOUT qq[sup\n]; print STDERR qq[yo\n]' ],
  40   expect => {
  41    status => 0,
  42    out    => "sup\n",
  43    err    => "yo\n",
  44   },
  45  },
  46  {
  47   desc   => 'long',
  48   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" ],
  49   expect => {
  50    status => 0,
  51    out    => ('a' x $long_length) . ('c' x $long_length),
  52    err    => ('b' x $long_length),
  53   },
  54  },
  55 );
  56
  57 for my $eol_spec (qw<0D 0A 0D0A 0A0D>) {
  58  (my $eol = $eol_spec) =~ s/(..)/\\x{$1}/g;
  59
  60  my $eol_exp;
  61  {
  62   local $@;
  63   $eol_exp = eval qq["$eol"];
  64   die $@ if $@;
  65  }
  66  push @tests, {
  67   desc   => "End of line $eol",
  68   cmd    => [ $^X, '-e', "print STDOUT qq[out$eol]; print STDERR qq[err$eol]" ],
  69   expect => {
  70    status => 0,
  71    out    => "out$eol_exp",
  72    err    => "err$eol_exp",
  73   },
  74   hexcmp  => 1,
  75  };
  76
  77  my $eol_bin_exp = ($^O eq 'MSWin32' && $eol_spec eq '0D0A')
  78                    ? chr 0x0A : $eol_exp;
  79  push @tests, {
  80   desc   => "End of line $eol (binary mode)",
  81   cmd    => [ $^X, '-e', "binmode *STDOUT; print STDOUT qq[out$eol]; binmode *STDERR; print STDERR qq[err$eol]" ],
  82   expect => {
  83    status => 0,
  84    out    => "out$eol_bin_exp",
  85    err    => "err$eol_bin_exp",
  86   },
  87   hexcmp  => 1,
  88  };
  89 }
  90
  91 push @tests, {
  92  desc   => 'Non-existent',
  93  cmd    => [ 'nonexistentexecutable' ],
  94  expect => {
  95   status => undef,
  96   out    => qr/open3.*exec.*failed/,
  97   err    => undef,
  98  },
  99 };
 100
 101 push @tests, {
 102  desc   => 'Exception',
 103  cmd    => [ $^X, '-e', 'die q[carrot]' ],
 104  expect => {
 105   status => 255 << 8,
 106   out    => '',
 107   err    => qr/carrot at -e/,
 108  },
 109 };
 110
 111 for my $test (@tests) {
 112  my $desc     = $test->{desc};
 113  my $expected = $test->{expect};
 114
 115  local $@;
 116  my ($status, $out, $err) = eval { capture @{ $test->{cmd} } };
 117
 118  is $@,      '',                  "$desc: did not croak";
 119  is $status, $expected->{status}, "$desc: status";
 120
 121  my ($exp_out, $exp_err) = @$expected{qw<out err>};
 122  if ($test->{hexcmp}) {
 123   $_       = hexdump($_)       for $out, $err;
 124   $exp_out = hexdump($exp_out) unless ref $exp_out;
 125   $exp_err = hexdump($exp_err) unless ref $exp_err;
 126  }
 127  if (ref $exp_out) {
 128   like $out, $exp_out, "$desc: out";
 129  } else {
 130   is   $out, $exp_out, "$desc: out";
 131  }
 132  if (ref $exp_err) {
 133   like $err, $exp_err, "$desc: err";
 134  } else {
 135   is   $err, $exp_err, "$desc: err";
 136  }
 137 }