Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Automatic filehandle discipline inheritance, take two. [rt.cpan.org 4…
…6542]

"use open" was problematic.  See
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-03/msg00278.html
and
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-03/msg00355.html
but we only need it for testing.
And all we really care about is utf8.  So just use binmode() and only test utf8.
  • Loading branch information
schwern committed Aug 28, 2010
1 parent e6b5287 commit 401fa01
Show file tree
Hide file tree
Showing 2 changed files with 17 additions and 11 deletions.
14 changes: 11 additions & 3 deletions lib/Test/Builder.pm
Expand Up @@ -1880,8 +1880,8 @@ sub _open_testhandles {
open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT: $!";
open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR: $!";

# $self->_copy_io_layers( \*STDOUT, $Testout );
# $self->_copy_io_layers( \*STDERR, $Testerr );
$self->_copy_io_layers( \*STDOUT, $Testout );
$self->_copy_io_layers( \*STDERR, $Testerr );

$self->{Opened_Testhandles} = 1;

Expand All @@ -1896,13 +1896,21 @@ sub _copy_io_layers {
require PerlIO;
my @src_layers = PerlIO::get_layers($src);

binmode $dst, join " ", map ":$_", @src_layers if @src_layers;
_apply_layers($dst, @src_layers) if @src_layers;
}
);

return;
}

sub _apply_layers {
my ($fh, @layers) = @_;
my %seen;
my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers;
binmode($fh, join(":", "", "raw", @unique));
}


=item reset_outputs
$tb->reset_outputs;
Expand Down
14 changes: 6 additions & 8 deletions t/utf8.t
Expand Up @@ -10,15 +10,14 @@ BEGIN {
use strict;
use warnings;

use Test::More skip_all => 'Not yet implemented';

my $have_perlio;
BEGIN {
# All together so Test::More sees the open discipline
$have_perlio = eval q[
use PerlIO;
use open ':std', ':locale';
use Test::More;
require PerlIO;
binmode *STDOUT, ":encoding(utf8)";
binmode *STDERR, ":encoding(utf8)";
require Test::More;
1;
];
}
Expand Down Expand Up @@ -53,10 +52,9 @@ SKIP: {
}
}

SKIP: {
skip( "Can't test in general because their locale is unknown", 2 )
unless $ENV{AUTHOR_TESTING};

# Test utf8 is ok.
{
my $uni = "\x{11e}";

my @warnings;
Expand Down

0 comments on commit 401fa01

Please sign in to comment.