X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F09-load-threads.t;h=9821d91ca51dffcfa2abc3a207b21248585c7de6;hb=3c079786e605cba895e2d8015a95be09eb45743b;hp=89cf8d3acf2522b3a2c29367b5c0e561d5e0d274;hpb=142a069ea963bd4da61bfe27c6a9b745ee3f6456;p=perl%2Fmodules%2FScope-Upper.git diff --git a/t/09-load-threads.t b/t/09-load-threads.t index 89cf8d3..9821d91 100644 --- a/t/09-load-threads.t +++ b/t/09-load-threads.t @@ -38,12 +38,14 @@ BEGIN { if (defined $thread_safe_var) { my $stat = run_perl "require POSIX; require $module; exit($thread_safe_var ? POSIX::EXIT_SUCCESS() : POSIX::EXIT_FAILURE())"; - require POSIX; - my $res = $stat >> 8; - if ($res == POSIX::EXIT_SUCCESS()) { - $is_threadsafe = 1; - } elsif ($res == POSIX::EXIT_FAILURE()) { - $is_threadsafe = !1; + if (defined $stat) { + require POSIX; + my $res = $stat >> 8; + if ($res == POSIX::EXIT_SUCCESS()) { + $is_threadsafe = 1; + } elsif ($res == POSIX::EXIT_FAILURE()) { + $is_threadsafe = !1; + } } if (not defined $is_threadsafe) { skip_all "Could not detect if $module is thread safe or not"; @@ -173,16 +175,24 @@ is_loaded 0, 'main body, after nested loadings'; use threads; use threads::shared; -my @locks = (1) x 5; -share($_) for @locks; +my @locks_down = (1) x 5; +my @locks_up = (0) x scalar @locks_down; +share($_) for @locks_down, @locks_up; + +my $peers = 2; sub sync_master { my ($id) = @_; { - lock $locks[$id]; - $locks[$id] = 0; - cond_broadcast $locks[$id]; + lock $locks_down[$id]; + $locks_down[$id] = 0; + cond_broadcast $locks_down[$id]; + } + + { + lock $locks_up[$id]; + cond_wait $locks_up[$id] until $locks_up[$id] == $peers; } } @@ -190,8 +200,14 @@ sub sync_slave { my ($id) = @_; { - lock $locks[$id]; - cond_wait $locks[$id] until $locks[$id] == 0; + lock $locks_down[$id]; + cond_wait $locks_down[$id] until $locks_down[$id] == 0; + } + + { + lock $locks_up[$id]; + $locks_up[$id]++; + cond_signal $locks_up[$id]; } } @@ -236,7 +252,7 @@ SKIP: { return; }); - sync_master($_) for 0 .. $#locks; + sync_master($_) for 0 .. $#locks_down; $thr1->join; if (my $err = $thr1->error) {