X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F09-load-threads.t;h=673f5cf0691641632100ae2e44aa8cadc4ffc905;hb=831f88dd7f6372e1a1f01db13f4c288fef0e2619;hp=d0e43221b8a618aaa28813d0efe47902ef2e61ca;hpb=993724a21f44593423b20167d3b3029cf547ba1c;p=perl%2Fmodules%2Findirect.git diff --git a/t/09-load-threads.t b/t/09-load-threads.t index d0e4322..673f5cf 100644 --- a/t/09-load-threads.t +++ b/t/09-load-threads.t @@ -65,11 +65,22 @@ sub is_loaded { my $res = load_test(); + my $expected; if ($affirmative) { - is $res, 1, "$desc: module loaded"; + $expected = 1; + $desc = "$desc: module loaded"; } else { - is $res, 0, "$desc: module not loaded"; + $expected = 0; + $desc = "$desc: module not loaded"; } + + unless (is $res, $expected, $desc) { + $res = defined $res ? "'$res'" : 'undef'; + $expected = "'$expected'"; + diag("Test '$desc' failed: got $res, expected $expected"); + } + + return; } BEGIN { @@ -174,16 +185,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 6; +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; } } @@ -191,25 +210,33 @@ 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]; } } SKIP: { my $thr1 = spawn(sub { my $here = 'first simultaneous thread'; - is_loaded 0, "$here, beginning"; sync_slave 0; + is_loaded 0, "$here, beginning"; + sync_slave 1; + do_load; is_loaded 1, "$here, after loading"; - sync_slave 1; sync_slave 2; - sync_slave 3; - is_loaded 1, "$here, still loaded while also loaded in the other thread"; + sync_slave 4; + is_loaded 1, "$here, still loaded while also loaded in the other thread"; + sync_slave 5; is_loaded 1, "$here, end"; @@ -220,24 +247,26 @@ SKIP: { my $thr2 = spawn(sub { my $here = 'second simultaneous thread'; - is_loaded 0, "$here, beginning"; sync_slave 0; + is_loaded 0, "$here, beginning"; sync_slave 1; - is_loaded 0, "$here, loaded in other thread but not here"; + sync_slave 2; + sync_slave 3; + is_loaded 0, "$here, loaded in other thread but not here"; do_load; is_loaded 1, "$here, after loading"; - sync_slave 3; sync_slave 4; + sync_slave 5; is_loaded 1, "$here, end"; return; }); - sync_master($_) for 0 .. $#locks; + sync_master($_) for 0 .. $#locks_down; $thr1->join; if (my $err = $thr1->error) {