#!perl BEGIN { unless (find PerlIO::Layer 'perlio') { print "1..0 # Skip: not perlio\n"; exit 0; } require Config; unless ($Config::Config{'usethreads'}) { print "1..0 # Skip -- need threads for this test\n"; exit 0; } if (($Config::Config{'extensions'} !~ m!\bPerlIO/via\b!) ){ print "1..0 # Skip -- Perl configured without PerlIO::via module\n"; exit 0; } } use strict; use warnings; use threads; my $tmp = "via$$"; END { 1 while unlink $tmp; } use Test::More tests => 2; our $push_count = 0; { open my $fh, ">:via(Test1)", $tmp or die "Cannot open $tmp: $!"; $fh->autoflush; print $fh "AXAX"; # previously this would crash threads->create( sub { print $fh "XZXZ"; })->join; print $fh "BXBX"; close $fh; open my $in, "<", $tmp; my $line = <$in>; close $in; is($line, "AYAYYZYZBYBY", "check thread data delivered"); is($push_count, 1, "PUSHED not called for dup on thread creation"); } package PerlIO::via::Test1; sub PUSHED { my ($class) = @_; ++$main::push_count; bless {}, $class; } sub WRITE { my ($self, $data, $fh) = @_; $data =~ tr/X/Y/; $fh->autoflush; print $fh $data; return length $data; }