1#!perl -T 2# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/15-*.t" -*- 3 4BEGIN { 5 $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /}; # taint vs tempfile 6 use Test::More; 7 eval "use PerlIO ()"; 8 plan skip_all => "PerlIO required for tempfile-preserve and other options" if $@; 9 eval "use Encode::Byte ()"; 10 plan skip_all => "Encode::Byte required to test at least Latin-2" if $@; 11} 12 13use Test::More tests => 3*2*5; 14 15use strict; 16use warnings; 17 18# For compatibility with perl <= 5.8.8, :crlf must be applied before :utf8. 19use Test::Trap::Builder::TempFile utf8 => { io_layers => ':crlf:utf8' }; 20use Test::Trap::Builder::TempFile both => { io_layers => ':crlf:utf8', preserve_io_layers => 1 }; 21use Test::Trap::Builder::TempFile latin2 => { io_layers => ':encoding(iso-8859-2)' }; 22use Test::Trap qw/ $basic basic :output(tempfile) /; 23use Test::Trap qw/ $preserve preserve :output(tempfile-preserve) /; 24use Test::Trap qw/ $utf8 utf8 :output(utf8) /; 25use Test::Trap qw/ $both both :output(both) /; 26use Test::Trap qw/ $latin2 latin2 :output(latin2) /; 27 28my @layers = qw(basic preserve utf8 both latin2); 29 30our($trap); 31sub trap(&); 32 33# For RT #102271: 34# The STDOUT may actually have a utf8 layer, from PERL_UNICODE or PERL5OPT or whatever. 35# So, check it: 36my $original_utf8 = grep { /utf8/ } PerlIO::get_layers(*STDOUT); 37 38# Test 1: ł (l stroke); no messing with STDOUT 39for my $glob (@layers) { 40 no strict 'refs'; 41 local *trap = *$glob; 42 trap { print "\x{142}" }; 43 if ($glob =~ /utf8|both|latin2/ or $original_utf8 && $glob eq 'preserve') { 44 # it should work 45 $trap->stdout_is("\x{142}", "TempFile '$glob' strategy handles l stroke"); 46 $trap->stderr_is('', "\t(no warning)"); 47 } 48 else { 49 $trap->stdout_is("\xC5\x82", "TempFile '$glob' strategy doesn't handle l stroke"); 50 $trap->stderr_like(qr/^Wide character in print.*$/, "\t(and warns)"); 51 } 52} 53 54# Test 2: π (pi); STDOUT binmoded to utf8 55binmode STDOUT, ':raw:utf8'; 56for my $glob (@layers) { 57 no strict 'refs'; 58 local *trap = *$glob; 59 trap { print "\x{3C0}" }; 60 if ($glob =~ /utf8|preserve|both/) { 61 # it should work 62 $trap->stdout_is("\x{3C0}", "TempFile '$glob' strategy handles pi"); 63 $trap->stderr_is('', "\t(no warning)"); 64 } 65 elsif ($glob eq 'latin2') { 66 $trap->stdout_like(qr/^\\x\{0?3c0\}\z/, "TempFile '$glob' strategy doesn't handle pi; falls back to \\x notation"); 67 $trap->stderr_like(qr/^"\\x\{0?3c0\}" does not map to iso-8859-2 .*$/, "\t(and warns)"); 68 } 69 else { 70 $trap->stdout_is("\xCF\x80", "TempFile '$glob' strategy doesn't handle pi"); 71 $trap->stderr_like(qr/^Wide character in print.*$/, "\t(and warns)"); 72 } 73} 74 75# Test 3: ‰\n% (per mille, newline, per cent); STDOUT binmoded to latin2 76binmode STDOUT, ':raw:encoding(iso-8859-2)'; 77for my $glob (@layers) { 78 no strict 'refs'; 79 local *trap = *$glob; 80 trap { print "\x{2030}\n%" }; 81 if ($glob =~ /utf8/) { 82 # it should work 83 $trap->stdout_is("\x{2030}\n%", "TempFile '$glob' strategy handles per mille"); 84 $trap->stderr_is('', "\t(no warning)"); 85 } 86 elsif ($glob =~ /preserve|both|latin2/) { 87 $trap->stdout_is("\\x{2030}\n%", "TempFile '$glob' strategy doesn't handle per mille; falls back to \\x notation"); 88 $trap->stderr_like(qr/^\Q"\x{2030}"\E does not map to iso-8859-2 .*$/, "\t(and warns)"); 89 } 90 else { 91 $trap->stdout_is("\xE2\x80\xB0\n%", "TempFile '$glob' strategy doesn't handle per mille"); 92 $trap->stderr_like(qr/^Wide character in print.*$/, "\t(and warns)"); 93 } 94} 95