This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop test suite filling /tmp
authorDavid Mitchell <davem@iabyn.com>
Wed, 3 Dec 2014 10:53:00 +0000 (10:53 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Dec 2014 10:53:00 +0000 (10:53 +0000)
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.

dist/Thread-Queue/t/07_lock.t
dist/Thread-Semaphore/t/01_basic.t
dist/Thread-Semaphore/t/04_nonblocking.t
dist/Thread-Semaphore/t/05_force.t
ext/SDBM_File/t/prep.t
lib/File/stat.t

index f9e258e..0af2db1 100644 (file)
@@ -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
index c5670bd..b10f725 100644 (file)
@@ -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
index a4e8cd6..d1538e8 100644 (file)
@@ -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
index c1ed70b..8803cfa 100644 (file)
@@ -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
index a222a64..14bd2e8 100644 (file)
@@ -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;
index 264ecd1..81f75f5 100644 (file)
@@ -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;