blob: 2de3a07b5b2bad316514c401f7fe8281b6dce0b7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
#!perl
BEGIN {
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;
}
|
