File: ithreads.pm

package info (click to toggle)
libapache2-mod-perl2 2.0.9~1624218-2%2Bdeb8u2
  • links: PTS, VCS
  • area: main
  • in suites: jessie
  • size: 11,912 kB
  • ctags: 4,588
  • sloc: perl: 95,064; ansic: 14,527; makefile: 49; sh: 18
file content (103 lines) | stat: -rw-r--r-- 2,770 bytes parent folder | download | duplicates (2)
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestPerl::ithreads;

use strict;
use warnings FATAL => 'all';

use Apache::Test;
use Apache::TestUtil;
use Apache::TestTrace;

use Apache2::Const -compile => 'OK';

# XXX: at this moment ithreads can be used only with 5.8.1. However
# once ithreads will be available on CPAN, we will need to change the
# check for perl 5.8.0 and this certain version of ithreads (here and
# in t/conf/post_config_startup.pl

sub handler {
    my $r = shift;

    plan $r, tests => 4, need
        need_threads,
        {"perl >= 5.8.1 is required (this is $])" => ($] >= 5.008001)};

    # threads must have been preloaded at the server startup for this
    # test (this is done at t/conf/post_config_startup.pl)
    require threads;
    threads->import();

    # sky: the more modules are loaded, the slower new ithreads start
    #      because more things need to be cloned
    debug '%INC size: ' . scalar(keys %INC) . "\n";

    {
        my $tid = threads->self->tid;
        debug "1st TID is $tid" if defined $tid;
        ok defined $tid;
    }

    {
        my $thr = threads->new(sub {
            my $tid = threads->self->tid;
            debug "2nd TID is $tid" if defined $tid;
            return 2;
        });
        ok t_cmp($thr->join, 2, "thread callback returned value");
    }

    {
        require threads::shared;
        my $counter_priv          = 1;
        my $counter_shar : shared = 1;

        my $thr = threads->new(sub {
            my $tid = threads->self->tid;
            debug "2nd TID is $tid" if defined $tid;
            $counter_priv += $counter_priv for 1..10;
            {
                lock $counter_shar;
                $counter_shar += $counter_shar for 1..10;
            }
        });

        $counter_priv += $counter_priv for 1..10;
        {
            lock $counter_shar;
            $counter_shar += $counter_shar for 1..10;
        }

        $thr->join;
        ok t_cmp($counter_shar, 2**20, "shared counter");
        ok t_cmp($counter_priv, 2**10, "private counter");
    }

    Apache2::Const::OK;
}

1;

__END__
# APACHE_TEST_CONFIG_ORDER 941

<VirtualHost TestPerl::ithreads>

    <IfDefine PERL_USEITHREADS>
        # a new interpreter pool
        PerlOptions +Parent
        PerlInterpStart         1
        PerlInterpMax           1
        PerlInterpMinSpare      1
        PerlInterpMaxSpare      1
    </IfDefine>

    # use test system's @INC
    PerlSwitches -I@serverroot@
    PerlRequire "conf/modperl_inc.pl"

    <Location /TestPerl__ithreads>
        SetHandler modperl
        PerlResponseHandler TestPerl::ithreads
    </Location>

</VirtualHost>