1*5759b3d2Safresh1#!/usr/bin/perl -w 2*5759b3d2Safresh1# HARNESS-NO-STREAM 3*5759b3d2Safresh1# HARNESS-NO-PRELOAD 4*5759b3d2Safresh1 5*5759b3d2Safresh1BEGIN { 6*5759b3d2Safresh1 if( $ENV{PERL_CORE} ) { 7*5759b3d2Safresh1 chdir 't'; 8*5759b3d2Safresh1 @INC = '../lib'; 9*5759b3d2Safresh1 } 10*5759b3d2Safresh1} 11*5759b3d2Safresh1 12*5759b3d2Safresh1use strict; 13*5759b3d2Safresh1use warnings; 14*5759b3d2Safresh1 15*5759b3d2Safresh1my $have_perlio; 16*5759b3d2Safresh1BEGIN { 17*5759b3d2Safresh1 # All together so Test::More sees the open discipline 18*5759b3d2Safresh1 $have_perlio = eval q[ 19*5759b3d2Safresh1 require PerlIO; 20*5759b3d2Safresh1 PerlIO->VERSION(1.02); # required for PerlIO::get_layers 21*5759b3d2Safresh1 binmode *STDOUT, ":encoding(utf8)"; 22*5759b3d2Safresh1 binmode *STDERR, ":encoding(utf8)"; 23*5759b3d2Safresh1 require Test::More; 24*5759b3d2Safresh1 1; 25*5759b3d2Safresh1 ]; 26*5759b3d2Safresh1} 27*5759b3d2Safresh1 28*5759b3d2Safresh1use Test::More; 29*5759b3d2Safresh1unless (Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter')) { 30*5759b3d2Safresh1 plan skip_all => 'Test cannot be run using this formatter'; 31*5759b3d2Safresh1} 32*5759b3d2Safresh1 33*5759b3d2Safresh1if( !$have_perlio ) { 34*5759b3d2Safresh1 plan skip_all => "Don't have PerlIO 1.02"; 35*5759b3d2Safresh1} 36*5759b3d2Safresh1else { 37*5759b3d2Safresh1 plan tests => 5; 38*5759b3d2Safresh1} 39*5759b3d2Safresh1 40*5759b3d2Safresh1SKIP: { 41*5759b3d2Safresh1 skip( "Need PerlIO for this feature", 3 ) 42*5759b3d2Safresh1 unless $have_perlio; 43*5759b3d2Safresh1 44*5759b3d2Safresh1 my %handles = ( 45*5759b3d2Safresh1 output => \*STDOUT, 46*5759b3d2Safresh1 failure_output => \*STDERR, 47*5759b3d2Safresh1 todo_output => \*STDOUT 48*5759b3d2Safresh1 ); 49*5759b3d2Safresh1 50*5759b3d2Safresh1 for my $method (keys %handles) { 51*5759b3d2Safresh1 my $src = $handles{$method}; 52*5759b3d2Safresh1 53*5759b3d2Safresh1 my $dest = Test::More->builder->$method; 54*5759b3d2Safresh1 55*5759b3d2Safresh1 is_deeply { map { $_ => 1 } PerlIO::get_layers($dest) }, 56*5759b3d2Safresh1 { map { $_ => 1 } PerlIO::get_layers($src) }, 57*5759b3d2Safresh1 "layers copied to $method"; 58*5759b3d2Safresh1 } 59*5759b3d2Safresh1} 60*5759b3d2Safresh1 61*5759b3d2Safresh1 62*5759b3d2Safresh1# Test utf8 is ok. 63*5759b3d2Safresh1{ 64*5759b3d2Safresh1 my $uni = "\x{11e}"; 65*5759b3d2Safresh1 66*5759b3d2Safresh1 my @warnings; 67*5759b3d2Safresh1 local $SIG{__WARN__} = sub { 68*5759b3d2Safresh1 push @warnings, @_; 69*5759b3d2Safresh1 }; 70*5759b3d2Safresh1 71*5759b3d2Safresh1 is( $uni, $uni, "Testing $uni" ); 72*5759b3d2Safresh1 is_deeply( \@warnings, [] ); 73*5759b3d2Safresh1} 74