| 1 |
|
|---|
| 2 | # as of 2.09 on win32 Storable w/threads dies with "free to wrong
|
|---|
| 3 | # pool" since it uses the same context for different threads. since
|
|---|
| 4 | # win32 perl implementation allocates a different memory pool for each
|
|---|
| 5 | # thread using the a memory pool from one thread to allocate memory
|
|---|
| 6 | # for another thread makes win32 perl very unhappy
|
|---|
| 7 | #
|
|---|
| 8 | # but the problem exists everywhere, not only on win32 perl , it's
|
|---|
| 9 | # just hard to catch it deterministically - since the same context is
|
|---|
| 10 | # used if two or more threads happen to change the state of the
|
|---|
| 11 | # context in the middle of the operation, and those operations aren't
|
|---|
| 12 | # atomic per thread, bad things including data loss and corrupted data
|
|---|
| 13 | # can happen.
|
|---|
| 14 | #
|
|---|
| 15 | # this has been solved in 2.10 by adding a Storable::CLONE which calls
|
|---|
| 16 | # Storable::init_perinterp() to create a new context for each new
|
|---|
| 17 | # thread when it starts
|
|---|
| 18 |
|
|---|
| 19 | sub BEGIN {
|
|---|
| 20 | if ($ENV{PERL_CORE}){
|
|---|
| 21 | chdir('t') if -d 't';
|
|---|
| 22 | @INC = ('.', '../lib');
|
|---|
| 23 | } else {
|
|---|
| 24 | unshift @INC, 't';
|
|---|
| 25 | }
|
|---|
| 26 | require Config; import Config;
|
|---|
| 27 | if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
|
|---|
| 28 | print "1..0 # Skip: Storable was not built\n";
|
|---|
| 29 | exit 0;
|
|---|
| 30 | }
|
|---|
| 31 | unless ($Config{'useithreads'} and eval { require threads; 1 }) {
|
|---|
| 32 | print "1..0 # Skip: no threads\n";
|
|---|
| 33 | exit 0;
|
|---|
| 34 | }
|
|---|
| 35 | # - is \W, so can't use \b at start. Negative look ahead and look behind
|
|---|
| 36 | # works at start/end of string, or where preceded/followed by spaces
|
|---|
| 37 | if ($] == 5.008002 and $Config{'ccflags'} =~ /(?<!\S)-DDEBUGGING(?!\S)/) {
|
|---|
| 38 | # Bug caused by change 21610, fixed by change 21849
|
|---|
| 39 | print "1..0 # Skip: tickles bug in threads combined with -DDEBUGGING on 5.8.2\n";
|
|---|
| 40 | exit 0;
|
|---|
| 41 | }
|
|---|
| 42 | }
|
|---|
| 43 |
|
|---|
| 44 | use Test::More;
|
|---|
| 45 |
|
|---|
| 46 | use strict;
|
|---|
| 47 |
|
|---|
| 48 | use threads;
|
|---|
| 49 | use Storable qw(nfreeze);
|
|---|
| 50 |
|
|---|
| 51 | plan tests => 2;
|
|---|
| 52 |
|
|---|
| 53 | threads->new(\&sub1);
|
|---|
| 54 |
|
|---|
| 55 | $_->join() for threads->list();
|
|---|
| 56 |
|
|---|
| 57 | ok 1;
|
|---|
| 58 |
|
|---|
| 59 | sub sub1 {
|
|---|
| 60 | nfreeze {};
|
|---|
| 61 | ok 1;
|
|---|
| 62 | }
|
|---|