#!perl -w
use constant HAS_THREADS => eval{ require threads };
use strict;
use Test::More;
BEGIN{
if($] < 5.010){
my $version = sprintf '%vd', $^V;
diag "Perl $version (<5.10.0) may leak scalars (probably it's a core problem).";
}
if(HAS_THREADS){
plan tests => 20;
}
else{
plan skip_all => 'no threads';
exit;
}
}
use FindBin qw($Bin);
use File::Spec;
use PerlIO::Util;
sub slurp{
my $file = shift;
open my $in, '<:raw', $file or die $!;
local $/;
return scalar <$in>;
}
my $file1 = File::Spec->join($Bin, 'util', 'thr1');
my $file2 = File::Spec->join($Bin, 'util', 'thr2');
ok open(my $tee, '>:tee', $file1, $file2), 'open:tee file1, file2';
#diag 'main ', $tee->inspect;
my $thr1 = threads->new(sub{
#diag 'subthr', $tee->inspect;
ok defined fileno($tee), 'opened (thr1)';
ok print($tee 'foo'), 'print (thr1)';
ok close($tee), 'close (thr1)';
});
$thr1->join();
ok print($tee 'bar'), 'print (main)';
ok close($tee), 'close (main)';
is slurp($file1), 'foobar', 'print to file1';
is slurp($file2), 'foobar', 'print to file2';
{
open my $out2, '>', $file2;
ok open($tee, '>:tee', $file1, $out2), 'open:tee file1, out2';
my $thr2 = threads->new(sub{
#diag 'subthr ', $tee->inspect;
ok defined fileno($tee), 'opend (thr2)';
ok print($tee 'FOO'), 'print (thr2)';
ok close($tee), 'close (thr2)';
});
$thr2->join();
ok print($tee 'BAR'), 'print (main)';
ok close($tee), 'close (main)';
ok print($out2 'BAZ'), 'print out2 (main)';
ok close($out2), 'close out2 (main)';
}
is slurp($file1), 'FOOBAR', 'print to file1';
is slurp($file2), 'FOOBARBAZ', 'print to out2';
ok unlink($file1), "unlink $file1";
ok unlink($file2), "unlink $file2";