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     if (! $Config{'useithreads'}) {
  11         print("1..0 # Skip: Perl not compiled with '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 use threads;
  33
  34 BEGIN {
  35     eval {
  36         require threads::shared;
  37         import threads::shared;
  38     };
  39     if ($@ || ! $threads::shared::threads_shared) {
  40         print("1..0 # Skip: threads::shared not available\n");
  41         exit(0);
  42     }
  43
  44     $| = 1;
  45     print("1..12\n");   ### Number of tests that will be run ###
  46 };
  47
  48 ok(1, 1, 'Loaded');
  49
  50 ### Start of Testing ###
  51
  52 my $i = 10;
  53 my $y = 20000;
  54
  55 my %localtime;
  56 for (0..$i) {
  57     $localtime{$_} = localtime($_);
  58 };
  59
  60 my $mutex = 2;
  61 share($mutex);
  62
  63 sub localtime_r {
  64     lock($mutex);
  65     my $retval = localtime(shift());
  66     return $retval;
  67 }
  68
  69 my @threads;
  70 for (0..$i) {
  71     my $thread = threads->create(sub {
  72                     my $arg = $_;
  73                     my $localtime = $localtime{$arg};
  74                     my $error = 0;
  75                     for (0..$y) {
  76                         my $lt = localtime($arg);
  77                         if($localtime ne $lt) {
  78                             $error++;
  79                         }
  80                     }
  81                     lock($mutex);
  82                     ok($mutex, ! $error, 'localtime safe');
  83                     $mutex++;
  84                   });
  85     push @threads, $thread;
  86 }
  87
  88 for (@threads) {
  89     $_->join();
  90 }
  91
  92 # EOF