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 sub ok {
  19     my ($id, $ok, $name) = @_;
  20
  21     # You have to do it this way or VMS will get confused.
  22     if ($ok) {
  23         print("ok $id - $name\n");
  24     } else {
  25         print("not ok $id - $name\n");
  26         printf("# Failed test at line %d\n", (caller)[2]);
  27     }
  28
  29     return ($ok);
  30 }
  31
  32 BEGIN { $| = 1; print "1..12\n"};
  33
  34 use threads;
  35 use threads::shared;
  36 ok(1, 1, 'Loaded');
  37
  38 my $i = 10;
  39 my $y = 20000;
  40 my %localtime;
  41 for(0..$i) {
  42         $localtime{$_} = localtime($_);
  43 };
  44 my $mutex = 2;
  45 share($mutex);
  46 sub localtime_r {
  47   lock($mutex);
  48   my $retval = localtime(shift());
  49   return $retval;
  50 }
  51 my @threads;
  52 for(0..$i) {
  53   my $thread = threads->create(sub {
  54                                  my $arg = $_;
  55                     my $localtime = $localtime{$arg};
  56                     my $error = 0;
  57                     for(0..$y) {
  58                       my $lt = localtime($arg);
  59                       if($localtime ne $lt) {
  60                         $error++;
  61                       }
  62                     }
  63                                  lock($mutex);
  64                                  ok($mutex, ! $error, 'localtime safe');
  65                                  $mutex++;
  66                   });
  67   push @threads, $thread;
  68 }
  69
  70 for(@threads) {
  71   $_->join();
  72 }
  73