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