File Coverage

blib/lib/threads.pm
Criterion Covered Total %
statement 14 48 29.1
branch 0 16 0.0
condition n/a
subroutine 5 12 41.6
pod n/a
total 19 76 25.0


line stmt bran cond sub pod time code
1             package threads;
2              
3 1     1   654 use 5.008;
  1         3  
4              
5 1     1   5 use strict;
  1         2  
  1         20  
6 1     1   5 use warnings;
  1         5  
  1         372  
7              
8             our $VERSION = '2.16';
9             my $XS_VERSION = $VERSION;
10             $VERSION = eval $VERSION;
11              
12             # Verify this Perl supports threads
13             require Config;
14             if (! $Config::Config{useithreads}) {
15             die("This Perl not built to support threads\n");
16             }
17              
18             # Complain if 'threads' is loaded after 'threads::shared'
19             if ($threads::shared::threads_shared) {
20             warn <<'_MSG_';
21             Warning, threads::shared has already been loaded. To
22             enable shared variables, 'use threads' must be called
23             before threads::shared or any module that uses it.
24             _MSG_
25             }
26              
27             # Declare that we have been loaded
28             $threads::threads = 1;
29              
30             # Load the XS code
31             require XSLoader;
32             XSLoader::load('threads', $XS_VERSION);
33              
34              
35             ### Export ###
36              
37             sub import
38             {
39 0     0     my $class = shift; # Not used
40              
41             # Exported subroutines
42 0           my @EXPORT = qw(async);
43              
44             # Handle args
45 0           while (my $sym = shift) {
46 0 0         if ($sym =~ /^(?:stack|exit)/i) {
    0          
    0          
47 0 0         if (defined(my $arg = shift)) {
48 0 0         if ($sym =~ /^stack/i) {
49 0           threads->set_stack_size($arg);
50             } else {
51 0           $threads::thread_exit_only = $arg =~ /^thread/i;
52             }
53             } else {
54 0           require Carp;
55 0           Carp::croak("threads: Missing argument for option: $sym");
56             }
57              
58             } elsif ($sym =~ /^str/i) {
59 0           import overload ('""' => \&tid);
60              
61             } elsif ($sym =~ /^(?::all|yield)$/) {
62 0           push(@EXPORT, qw(yield));
63              
64             } else {
65 0           require Carp;
66 0           Carp::croak("threads: Unknown import option: $sym");
67             }
68             }
69              
70             # Export subroutine names
71 0           my $caller = caller();
72 0           foreach my $sym (@EXPORT) {
73 1     1   5 no strict 'refs';
  1         2  
  1         249  
74 0           *{$caller.'::'.$sym} = \&{$sym};
  0            
  0            
75             }
76              
77             # Set stack size via environment variable
78 0 0         if (exists($ENV{'PERL5_ITHREADS_STACK_SIZE'})) {
79 0           threads->set_stack_size($ENV{'PERL5_ITHREADS_STACK_SIZE'});
80             }
81             }
82              
83              
84             ### Methods, etc. ###
85              
86             # Exit from a thread (only)
87             sub exit
88             {
89 0     0     my ($class, $status) = @_;
90 0 0         if (! defined($status)) {
91 0           $status = 0;
92             }
93              
94             # Class method only
95 0 0         if (ref($class)) {
96 0           require Carp;
97 0           Carp::croak('Usage: threads->exit(status)');
98             }
99              
100 0           $class->set_thread_exit_only(1);
101 0           CORE::exit($status);
102             }
103              
104             # 'Constant' args for threads->list()
105       0     sub threads::all { }
106 0     0     sub threads::running { 1 }
107 0     0     sub threads::joinable { 0 }
108              
109             # 'new' is an alias for 'create'
110             *new = \&create;
111              
112             # 'async' is a function alias for the 'threads->create()' method
113             sub async (&;@)
114             {
115 0     0     unshift(@_, 'threads');
116             # Use "goto" trick to avoid pad problems from 5.8.1 (fixed in 5.8.2)
117 0           goto &create;
118             }
119              
120             # Thread object equality checking
121             use overload (
122             '==' => \&equal,
123 0     0     '!=' => sub { ! equal(@_) },
124 1         12 'fallback' => 1
125 1     1   6 );
  1         2  
126              
127             1;
128              
129             __END__