1#!/usr/bin/env perl
2use strict;
3use warnings;
4
5use Config;
6BEGIN {
7  unless ($ENV{RELEASE_TESTING} || $ENV{EXTENDED_TESTING}) {
8    print("1..0 # Skip only in release or extended testing\n");
9    exit(0);
10  }
11  if (! $Config{useithreads} || $] < 5.008) {
12    print("1..0 # Skip perl isn't compiled with threading support\n");
13    exit(0);
14  }
15  # Should be be looking for newer than 5.008?
16  if (! eval { require threads }) {
17    print "1..0 # Skip threads.pm not installed\n";
18    exit 0;
19  }
20}
21
22# Math::Pari + threads = crossing the streams.  Instant segfault.
23use Math::BigInt lib=>"Calc";
24use Test::More 'tests' => 8;
25use Math::Prime::Util qw/:all srand/;
26
27my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING};
28my $is_win32 = ($Config{osname} eq 'MSWin32')  ?  1  :  0;
29
30# threads are memory hogs, so we want few of them.  But for testing purposes,
31# we want a lot of them.  4-8 perhaps.
32my $numthreads = 4;
33
34# Random numbers, pregenerated
35my @randn = (
36 qw/71094  1864 14650 58418 46196 45215 70355 80402 70420 33457 73424 45744
37    22229 61529 82574 61578 26369 76750 15724 61272 52128 77252  2207  3579
38    69734 14488 20846 46906  6992 43938 34945 51978 11336 58462 11973 75248
39    39165  8147 62890 63565 39279 47830 43617 40299 65372 37479   884 27007
40    24978 55716 38115 71502 30134 40903 71231 40095  9054 54133 13876 55660
41    44544  1880 39217 36609 38711 49576 55029 21831 75022 69128  2311 16321
42     1400  9659  6010  8206 78113 76539 17430 69393 26519 50162 49317 20231/);
43
44if ($extra) {
45  $numthreads *= 2;
46  push @randn, (qw/
47    11019 28515 73527 50147 33512 28347 19122 66580 14286 81842 38344 10886
48    52253 57834 37446 49360 24401 45815 54811  1703 38180 22473 17946 58833
49    29700 55366 35155 31902 28299 34139 51961 75210  9126 30331 54658 50208
50    13936 57086 27118 75817 31571 76715 53441 31118 22091 47356 67284 37756
51    67826   819 78844 64174 53566 28410 40455 76690 69141  2001  1251 39140
52     2328 49159 14379 73801 30195 19745 72355 51038 76557 63516 54486 45951
53    65586 61730  6310 73490 71132 25970 51034 27856 11490 25817 24283 52759
54    68248  9246 52896 72365 31983 74001 16616 63960 70718 43518 27054  6397
55     1247 64241 27517  2927  3557 76192 36376 21334  1395 20926 36088 65519
56     2650  9739 23758 74720 34458 41096 51926 45932 14850 38181 60833 53481
57     8086 43319 11891 22674 22916 72918  3650 35246 39543 25544 35578 67023
58    50752 29653 76351 64909  9425 27547 10108 13399 69540  3833 12748  6386
59    76511 28041 31586 50034  8828 17845 44376 74301 39762 40216  5092 16261
60     7434 29908 18671  7189 18373 31608 67155 19129 20586  6713 73424 20568
61    64299 71411 53762 20070 56014  3560  9129 50993 44983 15434  5035 77815
62    22836  9786 24808 50756 15298 48358 36466  4308   195 69058 55813 18840
63    23284 41448 37349 59268 36894 79674 31694 73975 71738 18344 26328  5264
64    79976 26714 27187 65237 18881 74975 28505 16271 51390 22598 65689 65512
65    20357 68743 72422 69481 26714  6824 30012/);
66}
67
68
69thread_test(
70  sub { my $sum = 0;  $sum += prime_count($_) for (@randn); return $sum;},
71  $numthreads, "sum prime_count");
72
73if (0) {
74SKIP: {
75  skip "Win32 needs precalc, skipping alloc/free stress test", 1 if $is_win32;
76
77  thread_test(
78    sub { my $sum = 0;  for (@randn) {$sum += prime_count($_); prime_memfree; } return $sum;},
79    $numthreads, "sum prime_count with overlapping memfree calls");
80}
81}
82
83thread_test(
84  sub { my $sum = 0; for my $d (@randn) { for my $f (factor($d)) { $sum += $f; } } return $sum; },
85  $numthreads, "factor");
86
87if (0) {
88thread_test(
89  sub { my $sum = 0;  $sum += nth_prime($_) for (@randn); return $sum;},
90  $numthreads, "nth_prime");
91}
92
93thread_test(
94  sub { my $sum = 0;  $sum += next_prime($_) for (@randn); return $sum;},
95  $numthreads, "next_prime");
96
97thread_test(
98  sub { my $sum = 0;  $sum += prev_prime($_) for (@randn); return $sum;},
99  $numthreads, "prev_prime");
100
101thread_test(
102  sub { my $sum = 0;  $sum += is_prime($_) for (@randn); return $sum;},
103  $numthreads, "is_prime");
104
105thread_test(
106  sub { my $sum = 0;  foreach my $n (@randn) { $sum += $_ for moebius($n,$n+50); } return $sum;},
107  $numthreads, "moebius");
108
109thread_test(
110  sub { my $sum = 0;  $sum += int(RiemannR($_)) for (@randn); return $sum;},
111  $numthreads, "RiemannR");
112
113# Requires per-thread context
114thread_test(
115  sub { srand(10); my $sum = 0;  $sum += irand for 1..1141; return $sum;},
116  $numthreads, "irand");
117
118sub thread_test {
119  my $tsub = shift;
120  my $nthreads = shift;
121  my $text = shift;
122
123  if ($is_win32) {
124    prime_precalc(1_200_000);  # enough for all these tests
125  }
126
127  my @threads;
128  # Fire off all our threads
129  push @threads, threads->create($tsub) for (1..$nthreads);
130  # Get results
131  my $par_sum = 0;
132  $par_sum += $_->join() for (@threads);
133  prime_memfree;
134
135  # Now do the same operation sequentially
136  my $seq_sum = 0;
137  $seq_sum += $tsub->() for (1..$nthreads);
138  prime_memfree;
139
140  SKIP: {
141    # If not doing extended testing, allow these to fail with a note.
142    if (!$extra && $par_sum != $seq_sum) {
143      diag "Threading test $text got $par_sum, expected $seq_sum";
144      skip "Threading failure", 1;
145    }
146    is($par_sum, $seq_sum, "$nthreads threads $text");
147  }
148}
149