1#!perl 2BEGIN { 3 unless (find PerlIO::Layer 'perlio') { 4 print "1..0 # Skip: not perlio\n"; 5 exit 0; 6 } 7 require Config; 8 unless ($Config::Config{'usethreads'}) { 9 print "1..0 # Skip -- need threads for this test\n"; 10 exit 0; 11 } 12 if (($Config::Config{'extensions'} !~ m!\bPerlIO/via\b!) ){ 13 print "1..0 # Skip -- Perl configured without PerlIO::via module\n"; 14 exit 0; 15 } 16} 17 18use strict; 19use warnings; 20use threads; 21 22my $tmp = "via$$"; 23 24END { 25 1 while unlink $tmp; 26} 27 28use Test::More tests => 2; 29 30our $push_count = 0; 31 32{ 33 open my $fh, ">:via(Test1)", $tmp 34 or die "Cannot open $tmp: $!"; 35 $fh->autoflush; 36 37 print $fh "AXAX"; 38 39 # previously this would crash 40 threads->create( 41 sub { 42 print $fh "XZXZ"; 43 })->join; 44 45 print $fh "BXBX"; 46 close $fh; 47 48 open my $in, "<", $tmp; 49 my $line = <$in>; 50 close $in; 51 52 is($line, "AYAYYZYZBYBY", "check thread data delivered"); 53 54 is($push_count, 1, "PUSHED not called for dup on thread creation"); 55} 56 57package PerlIO::via::Test1; 58 59sub PUSHED { 60 my ($class) = @_; 61 ++$main::push_count; 62 bless {}, $class; 63} 64 65sub WRITE { 66 my ($self, $data, $fh) = @_; 67 $data =~ tr/X/Y/; 68 $fh->autoflush; 69 print $fh $data; 70 return length $data; 71} 72 73 74