view release on metacpan or  search on metacpan

t/13-stdout-tied.t  view on Meta::CPAN

binmode($builder->failure_output, ':utf8') if $] >= 5.008;
binmode($builder->todo_output, ':utf8') if $] >= 5.008;

save_std(qw/stdout/);
tie *STDOUT, 'TieLC', ">&=STDOUT";
my $orig_tie = tied *STDOUT;
ok( $orig_tie, "STDOUT is tied" ); 

my $fd = next_fd;

run_test($_, 'unicode') for qw(
  capture
  capture_scalar
  capture_merged
);

if ( ! $no_fork ) {
  run_test($_, 'unicode') for qw(
    tee
    tee_scalar
    tee_merged
  );
}

is( next_fd, $fd, "no file descriptors leaked" );
is( tied *STDOUT, $orig_tie, "STDOUT is still tied" );
restore_std(qw/stdout/);

t/14-stderr-tied.t  view on Meta::CPAN

binmode($builder->failure_output, ':utf8') if $] >= 5.008;
binmode($builder->todo_output, ':utf8') if $] >= 5.008;

save_std(qw/stderr/);
tie *STDERR, 'TieLC', ">&=STDERR";
my $orig_tie = tied *STDERR;
ok( $orig_tie, "STDERR is tied" );

my $fd = next_fd;

run_test($_, 'unicode') for qw(
  capture
  capture_scalar
  capture_merged
);

if ( ! $no_fork ) {
  run_test($_, 'unicode') for qw(
    tee
    tee_scalar
    tee_merged
  );
}

is( next_fd, $fd, "no file descriptors leaked" );
is( tied *STDERR, $orig_tie, "STDERR is still tied" );
restore_std(qw/stderr/);

t/lib/Cases.pm  view on Meta::CPAN

};

sub _is_or_diff {
  my ($g,$e,$l) = @_;
  if ( $have_diff ) { eq_or_diff( $g, $e, $l ); }
  else { is( $g, $e, $l ); }
}

sub _binmode {
  my $text = shift;
  return $text eq 'unicode' ? 'binmode(STDOUT,q{:utf8}); binmode(STDERR,q{:utf8});' : '';
}

sub _set_utf8 {
  my $t = shift;
  return unless $t eq 'unicode';
  my %seen;
  my @orig_layers = grep {$_ ne 'unix' and $_ ne 'perlio' and $seen{$_}++} PerlIO::get_layers(\*STDOUT);
  binmode(STDOUT, ":utf8") if fileno(STDOUT); 
  binmode(STDERR, ":utf8") if fileno(STDERR); 
  return @orig_layers;
}

sub _restore_layers {
  my ($t, @orig_layers) = @_;
  return unless $t eq 'unicode';
  binmode(STDOUT, join( ":", "", "raw", @orig_layers)) if fileno(STDOUT); 
  binmode(STDERR, join( ":", "", "raw", @orig_layers)) if fileno(STDERR); 
}

#--------------------------------------------------------------------------#

my %texts = (
  short => 'Hello World',
  multiline => 'First line\nSecond line\n',
  ( $] lt "5.008" ? () : ( unicode => 'Hi! \x{263a}\n') ),
);

#--------------------------------------------------------------------------#
#  fcn($perl_code_string) => execute the perl in current process or subprocess
#--------------------------------------------------------------------------#

my %methods = (
  perl    => sub { eval $_[0]; $_[0] },
  sys  => sub { system($^X, '-e', $_[0]); $_[0] },
);