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