ext/threads/t/libc.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     if ($ENV{'PERL_CORE'}){
   6         chdir 't';
   7         unshift @INC, '../lib';
   8     }
   9     use Config;
  10     unless ($Config{'useithreads'}) {
  11         print "1..0 # Skip: no useithreads\n";
  12         exit 0;
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18 BEGIN { $| = 1; print "1..11\n"};
  19
  20 use threads;
  21 use threads::shared;
  22 my $i = 10;
  23 my $y = 20000;
  24 my %localtime;
  25 for(0..$i) {
  26         $localtime{$_} = localtime($_);
  27 };
  28 my $mutex = 1;
  29 share($mutex);
  30 sub localtime_r {
  31 #  print "Waiting for lock\n";
  32   lock($mutex);
  33 #  print "foo\n";
  34   my $retval = localtime(shift());
  35 #  unlock($mutex);
  36   return $retval;
  37 }
  38 my @threads;
  39 for(0..$i) {
  40   my $thread = threads->create(sub {
  41                                  my $arg = $_;
  42                     my $localtime = $localtime{$arg};
  43                     my $error = 0;
  44                     for(0..$y) {
  45                       my $lt = localtime($arg);
  46                       if($localtime ne $lt) {
  47                         $error++;
  48                       }
  49                     }
  50                                  lock($mutex);
  51                                  if($error) {
  52                                    print "not ok $mutex # not a safe localtime\n";
  53                                  } else {
  54                                    print "ok $mutex\n";
  55                                  }
  56                                  $mutex++;
  57                   });
  58   push @threads, $thread;
  59 }
  60
  61 for(@threads) {
  62   $_->join();
  63 }
  64