diff options
Diffstat (limited to 'ext/PerlIO-via/t/thread.t')
-rw-r--r-- | ext/PerlIO-via/t/thread.t | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/ext/PerlIO-via/t/thread.t b/ext/PerlIO-via/t/thread.t new file mode 100644 index 0000000000..e4358f9c24 --- /dev/null +++ b/ext/PerlIO-via/t/thread.t @@ -0,0 +1,73 @@ +#!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; +} + + |