1#!perl 2 3use strict; 4use warnings FATAL => 'all'; 5use Test::More tests => 42; 6 7use FindBin qw($Bin); 8use File::Spec; 9use IO::Handle (); 10 11use PerlIO::Util; 12 13use constant USING_CRLF 14 => scalar( grep{ $_ eq 'crlf' } STDOUT->get_layers() ); 15 16my $file1 = File::Spec->join($Bin, 'util', 'tee1'); 17my $file2 = File::Spec->join($Bin, 'util', 'tee2'); 18my($x, $y, $tee); 19 20sub slurp{ 21 my $file = shift; 22 open my $in, '<:raw', $file or die $!; 23 local $/; 24 return scalar <$in>; 25} 26 27my $CRLF = "\x0D\x0A"; 28 29ok open($tee, ">:tee", \($x, $y)), "open:tee scalar, scalar"; 30ok binmode($tee), "binmode"; 31 32print $tee "foo\n"; 33close $tee; 34 35is $x, "foo\n", "binmode:raw (1) via :scalar"; 36is $y, "foo\n", "binmode:raw (2) via :scalar"; 37 38ok open($tee, ">:tee", \($x, $y)), "open:tee scalar, scalar"; 39ok binmode($tee, ':crlf'), "binmode(crlf)"; 40 41print $tee "foo\n"; 42close $tee; 43 44is $x, "foo$CRLF", "binmode:crlf (1) via :scalar"; 45is $y, "foo$CRLF", "binmode:crlf (2) via :scalar"; 46 47 48ok open($tee, '>:tee', $file1, $file2), "open:tee (file, file)"; 49$tee->autoflush(1); 50ok binmode($tee, ':crlf'), 'binmode(crlf)'; 51 52print $tee "\n"; 53is slurp($file1), $CRLF, "binmode:crlf (1)"; 54is slurp($file2), $CRLF, "binmode:crlf (2)"; 55 56#ok open($tee, '>>:tee', $file1, $file2), "open"; 57ok binmode($tee), 'binmode()'; 58print $tee "\n"; 59is slurp($file1), "$CRLF\n", "binmode:raw (1)"; 60is slurp($file2), "$CRLF\n", "binmode:raw (2)"; 61 62ok open($tee, '>:tee', \$x, $file1), "open:tee scalar, file"; 63$tee->autoflush(1); 64 65ok binmode($tee), 'binmode()'; 66print $tee "foobar", "\n"; 67is slurp($file1), "foobar\n", "binmode:raw (1)"; 68is $x, "foobar\n", "binmode:raw (2)"; 69 70ok binmode($tee, ':crlf'), 'binmode(crlf)'; 71print $tee "\n"; 72is slurp($file1), "foobar\n$CRLF", "binmode:crlf (1)"; 73is $x, "foobar\n$CRLF", "binmode:crlf (2)"; 74 75ok binmode($tee), 'binmode()'; 76print $tee "\n"; 77is slurp($file1), "foobar\n$CRLF\n", "binmode:raw (1)"; 78is $x, "foobar\n$CRLF\n", "binmode:raw (2)"; 79 80close $tee; 81 82SKIP:{ 83 skip '":crlf" is default', 10 if USING_CRLF; 84 85 ok open($tee, '>:tee', $file1, \$x), "open:tee file, scalar"; 86 $tee->autoflush(1); 87 88 ok binmode($tee), 'binmode()'; 89 90 print $tee "foobar", "\n"; 91 is slurp($file1), "foobar\n", "binmode:raw (1)"; 92 is $x, "foobar\n", "binmode:raw (2)"; 93 94 ok binmode($tee, ':crlf'), 'binmode(crlf)'; 95 96 print $tee "\n"; 97 is slurp($file1), "foobar\n$CRLF", "binmode:crlf (1)"; 98 is $x, "foobar\n$CRLF", "binmode:crlf (2)"; 99 100 ok binmode($tee), 'binmode()'; 101 102 print $tee "\n"; 103 is slurp($file1), "foobar\n$CRLF\n", "binmode:raw (1)"; 104 is $x, "foobar\n$CRLF\n", "binmode:raw (2)"; 105 106 close $tee; 107} 108 109# binmode clears UTF8 mode 110open $tee, '>:tee :utf8', \($x, $y); 111 112ok scalar(grep{ $_ eq 'utf8' } $tee->get_layers()), ':tee with :utf8'; 113 114eval{ 115 print $tee "\x{99f1}\x{99dd}"; 116}; 117is $@, '', 'output utf8 string'; 118 119ok binmode($tee), 'binmode()'; 120 121eval{ 122 print $tee "\x{99f1}\x{99dd}"; 123}; 124isnt $@, '', 'after binmode: warns "Wide character in print"'; 125 126ok!scalar(grep{ $_ eq 'utf8' } $tee->get_layers()), 'binmode:raw'; 127 128close $tee; 129 130 131ok unlink($file1), "unlink $file1"; 132ok unlink($file2), "unlink $file2"; 133 134# patch to make spaces visible 135BEGIN{ 136 my $orig = Test::More->builder->can('_is_diag'); 137 138 sub my_is_diag{ 139 my($self, $got, $type, $expect) = @_; 140 141 if($type eq 'eq'){ 142 for my $v($got, $expect){ 143 if(defined $v){ 144 $v =~ s/(\s)/sprintf '\\x%02X', $1/eg; 145 } 146 } 147 } 148 $self->$orig($got, $type, $expect); 149 } 150 151 no strict 'refs'; no warnings 'redefine'; 152 *{ref(Test::More->builder) . "::_is_diag"} = \&my_is_diag; 153} 154 155