This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dist/threads/t/libc.t: Add timer to avoid deadlock
[perl5.git] / dist / threads / t / libc.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
6
7     use Config;
8     if (! $Config{'useithreads'}) {
9         skip_all(q/Perl not compiled with 'useithreads'/);
10     }
11
12     my $time_out_factor = $ENV{PERL_TEST_TIME_OUT_FACTOR} || 1;
13     $time_out_factor = 1 if $time_out_factor < 1;
14
15     # Guard against bugs that result in deadlock
16     watchdog(1 * 60 * $time_out_factor);
17
18     plan(11);
19 }
20
21 use ExtUtils::testlib;
22
23 use_ok('threads');
24
25 ### Start of Testing ###
26
27 my $i = 10;
28 my $y = 20000;
29
30 my %localtime;
31 for (1..$i) {
32     $localtime{$_} = localtime($_);
33 };
34
35 my @threads;
36 for (1..$i) {
37     $threads[$_] = threads->create(sub {
38                         my $arg = shift;
39                         my $localtime = $localtime{$arg};
40                         my $error = 0;
41                         for (1..$y) {
42                             my $lt = localtime($arg);
43                             if ($localtime ne $lt) {
44                                 $error++;
45                             }
46                         }
47                         return $error;
48                     }, $_);
49 }
50
51 for (1..$i) {
52     is($threads[$_]->join(), 0, 'localtime() thread-safe');
53 }
54
55 exit(0);
56
57 # EOF