In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c6eacdc3acc965cb069ded02e066d3c00e9385df?hp=1037353b7e5ab2b2522d601c33d3c548ab4cd100>
- Log ----------------------------------------------------------------- commit c6eacdc3acc965cb069ded02e066d3c00e9385df Author: David Mitchell <[email protected]> Date: Wed Dec 3 10:53:00 2014 +0000 Stop test suite filling /tmp Some test files use File::Temp in such a way that the temporary files and directories under /tmp aren't deleted at the end. On a smoker system, this can gradually accumulate thousands of entries under /tmp. The general culprits fixed by this commit are: 1) using tempfile() without the UNLINK => 1 argument; 2) Using Test::More (which uses Test::Stream), which creates a test directory in such a way that only the original parent thread will remove it; for some reason I still don't fully understand, detaching a thread rather than joining it stops this clean up happening. In the affected test files, I replaced the ->detach() with a ->join() just before exit, and the problem went away. Some tests under cpan/ are still leaky; these will be addressed upstream. ----------------------------------------------------------------------- Summary of changes: dist/Thread-Queue/t/07_lock.t | 6 ++++-- dist/Thread-Semaphore/t/01_basic.t | 12 ++++++++---- dist/Thread-Semaphore/t/04_nonblocking.t | 5 +++-- dist/Thread-Semaphore/t/05_force.t | 6 ++++-- ext/SDBM_File/t/prep.t | 4 ++-- lib/File/stat.t | 2 +- 6 files changed, 22 insertions(+), 13 deletions(-) diff --git a/dist/Thread-Queue/t/07_lock.t b/dist/Thread-Queue/t/07_lock.t index f9e258e..0af2db1 100644 --- a/dist/Thread-Queue/t/07_lock.t +++ b/dist/Thread-Queue/t/07_lock.t @@ -29,7 +29,7 @@ ok($q, 'New queue'); my $sm = Thread::Semaphore->new(0); my $st = Thread::Semaphore->new(0); -threads->create(sub { +my $thread = threads->create(sub { { lock($q); $sm->up(); @@ -39,7 +39,7 @@ threads->create(sub { my @x = $q->extract(5,2); is_deeply(\@x, [6,7], 'Thread dequeues under lock'); } -})->detach(); +}); $sm->down(); $st->up(); @@ -47,6 +47,8 @@ my @x = $q->dequeue_nb(100); is_deeply(\@x, [1..5,8..10], 'Main dequeues'); threads::yield(); +$thread->join; + exit(0); # EOF diff --git a/dist/Thread-Semaphore/t/01_basic.t b/dist/Thread-Semaphore/t/01_basic.t index c5670bd..b10f725 100644 --- a/dist/Thread-Semaphore/t/01_basic.t +++ b/dist/Thread-Semaphore/t/01_basic.t @@ -30,7 +30,9 @@ ok($st, 'New Semaphore'); my $token :shared = 0; -threads->create(sub { +my @threads; + +push @threads, threads->create(sub { $st->down(); is($token++, 1, 'Thread 1 got semaphore'); $st->up(); @@ -39,9 +41,9 @@ threads->create(sub { $st->down(4); is($token, 5, 'Thread 1 done'); $sm->up(); -})->detach(); +}); -threads->create(sub { +push @threads, threads->create(sub { $st->down(2); is($token++, 3, 'Thread 2 got semaphore'); $st->up(); @@ -50,7 +52,7 @@ threads->create(sub { $st->down(4); is($token, 5, 'Thread 2 done'); $sm->up(); -})->detach(); +}); $sm->down(); is($token++, 0, 'Main has semaphore'); @@ -69,6 +71,8 @@ $st->down(); ok(1, 'Main done'); threads::yield(); +$_->join for @threads; + exit(0); # EOF diff --git a/dist/Thread-Semaphore/t/04_nonblocking.t b/dist/Thread-Semaphore/t/04_nonblocking.t index a4e8cd6..d1538e8 100644 --- a/dist/Thread-Semaphore/t/04_nonblocking.t +++ b/dist/Thread-Semaphore/t/04_nonblocking.t @@ -30,7 +30,7 @@ ok($st, 'New Semaphore'); my $token :shared = 0; -threads->create(sub { +my $thread = threads->create(sub { ok(! $st->down_nb(), 'Semaphore unavailable to thread'); $sm->up(); @@ -42,7 +42,7 @@ threads->create(sub { ok(! $st->down_nb(), 'Semaphore unavailable to thread'); is($token++, 1, 'Thread done'); $sm->up(); -})->detach(); +}); $sm->down(1); is($token++, 0, 'Main has semaphore'); @@ -54,6 +54,7 @@ $st->up(4); $sm->down(); is($token++, 2, 'Main got semaphore'); +$thread->join; exit(0); # EOF diff --git a/dist/Thread-Semaphore/t/05_force.t b/dist/Thread-Semaphore/t/05_force.t index c1ed70b..8803cfa 100644 --- a/dist/Thread-Semaphore/t/05_force.t +++ b/dist/Thread-Semaphore/t/05_force.t @@ -30,7 +30,7 @@ ok($st, 'New Semaphore'); my $token :shared = 0; -threads->create(sub { +my $thread = threads->create(sub { $st->down_force(2); is($token++, 0, 'Thread got semaphore'); $sm->up(); @@ -38,7 +38,7 @@ threads->create(sub { $st->down(); is($token++, 3, 'Thread done'); $sm->up(); -})->detach(); +}); $sm->down(); is($token++, 1, 'Main has semaphore'); @@ -54,6 +54,8 @@ is($token, 4, 'Main re-got semaphore'); ok(1, 'Main done'); threads::yield(); +$thread->join; + exit(0); # EOF diff --git a/ext/SDBM_File/t/prep.t b/ext/SDBM_File/t/prep.t index a222a64..14bd2e8 100644 --- a/ext/SDBM_File/t/prep.t +++ b/ext/SDBM_File/t/prep.t @@ -6,8 +6,8 @@ use SDBM_File; use File::Temp 'tempfile'; use Fcntl; -my ($dirfh, $dirname) = tempfile(); -my ($pagfh, $pagname) = tempfile(); +my ($dirfh, $dirname) = tempfile(UNLINK => 1); +my ($pagfh, $pagname) = tempfile(UNLINK => 1); # close so Win32 allows them to be re-opened close $dirfh; diff --git a/lib/File/stat.t b/lib/File/stat.t index 264ecd1..81f75f5 100644 --- a/lib/File/stat.t +++ b/lib/File/stat.t @@ -13,7 +13,7 @@ use File::Temp qw( tempfile tempdir ); use File::stat; -my (undef, $file) = tempfile(); +my (undef, $file) = tempfile(UNLINK => 1); { my @stat = CORE::stat $file; -- Perl5 Master Repository
