1#!perl -T
2# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/16-*.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 systemsafe-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::SystemSafe utf8   => { io_layers => ':crlf:utf8' };
20use Test::Trap::Builder::SystemSafe both   => { io_layers => ':crlf:utf8', preserve_io_layers => 1 };
21use Test::Trap::Builder::SystemSafe latin2 => { io_layers => ':encoding(iso-8859-2)' };
22use Test::Trap qw/ $basic    basic    :output(systemsafe)          /;
23use Test::Trap qw/ $preserve preserve :output(systemsafe-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}", "SystemSafe '$glob' strategy handles l stroke");
46    $trap->stderr_is('', "\t(no warning)");
47  }
48  else {
49    $trap->stdout_is("\xC5\x82", "SystemSafe '$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}", "SystemSafe '$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/, "SystemSafe '$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", "SystemSafe '$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%", "SystemSafe '$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%", "SystemSafe '$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%", "SystemSafe '$glob' strategy doesn't handle per mille");
92    $trap->stderr_like(qr/^Wide character in print.*$/, "\t(and warns)");
93  }
94}
95