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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
use strict;
use warnings FATAL => 'all';
#
# there is a problem when STDOUT is internally opened to an
# Apache2::PerlIO layer is cloned on a new thread start. PerlIO_clone
# in perl_clone() is called too early, before PL_defstash is
# cloned. As PerlIO_clone calls PerlIOApache_getarg, which calls
# gv_fetchpv via sv_setref_pv and boom the segfault happens.
#
# at the moment we should either not use an internally opened to
# :Apache2 streams, so the config must be:
#
# SetHandler modperl
#
# and then either use $r->print("foo") or tie *STDOUT, $r + print "foo"
#
# or close and re-open STDOUT to :Apache2 *after* the thread was spawned
#
# the above discussion equally applies to STDIN
#
# XXX: ->join calls leak under registry, this doesn't happen in the
# non-registry tests.
use threads;
my $r = shift;
$r->print("Content-type: text/plain\n\n");
{
# now we can use $r->print API:
my $thr = threads->new(
sub {
my $id = shift;
$r->print("thread $id\n");
return 1;
}, 1);
# $thr->join; # XXX: leaks scalar
}
{
# close and re-open STDOUT to :Apache2 *after* the thread was
# spawned
my $thr = threads->new(
sub {
my $id = shift;
close STDOUT;
open STDOUT, ">:Apache2", $r
or die "can't open STDOUT via :Apache2 layer : $!";
print "thread $id\n";
return 1;
}, 2);
# $thr->join; # XXX: leaks scalar
}
{
# tie STDOUT to $r *after* the ithread was started has
# happened, in which case we can use print
my $thr = threads->new(
sub {
my $id = shift;
tie *STDOUT, $r;
print "thread $id\n";
return 1;
}, 3);
# $thr->join; # XXX: leaks scalar
}
{
# tie STDOUT to $r before the ithread was started has
# happened, in which case we can use print
tie *STDOUT, $r;
my $thr = threads->new(
sub {
my $id = shift;
print "thread $id\n";
return 1;
}, 4);
# $thr->join; # XXX: leaks scalar
}
sleep 2; # XXX: will go away ones join() calls are enabled
print "parent\n";
untie *STDOUT; # don't affect other tests
|
