The Tcpdump Group git mirrors - libpcap/blob - testprogs/TESTmt.pm

   1 use strict;
   2 use warnings FATAL => qw(uninitialized);
   3 use threads;
   4 use Thread::Queue;
   5
   6 # TESTrun helper functions (multithreaded implementation).
   7
   8 my $njobs;
   9 my $tmpid;
  10 my @tests;
  11 my @result_queues;
  12 my @tester_threads;
  13 my $next_to_dequeue;
  14
  15 sub my_tmp_id {
  16         return $tmpid;
  17 }
  18
  19 sub set_njobs {
  20         $njobs = shift;
  21         print "INFO: This Perl supports threads, using $njobs tester thread(s).\n";
  22 }
  23
  24 # Iterate over the list of tests, pick tests that belong to the current job,
  25 # run one test at a time and send the result to the job's results queue.
  26 sub tester_thread_func {
  27         my $jobid = shift;
  28         $tmpid = sprintf 'job%03u', $jobid;
  29         for (my $i = $jobid; $i < scalar @tests; $i += $njobs) {
  30                 my $result = $tests[$i]{func} ($tests[$i]->%*);
  31                 $result->{label} = $tests[$i]{label};
  32                 $result_queues[$jobid]->enqueue ($result);
  33         }
  34         # Instead of detaching let the receiver join, this works around File::Temp
  35         # not cleaning up.
  36         $result_queues[$jobid]->end;
  37 }
  38
  39 sub start_tests {
  40         @tests = @_;
  41         for (0 .. $njobs - 1) {
  42                 $result_queues[$_] = Thread::Queue->new;
  43                 $tester_threads[$_] =  threads->create (\&tester_thread_func, $_);
  44         }
  45         $next_to_dequeue = 0;
  46 }
  47
  48 # Here ordering of the results is the same as ordering of the tests because
  49 # this function starts at job 0 and continues round-robin, which reverses the
  50 # interleaving done in the thread function above; also because every attempt
  51 # to dequeue blocks until it returns exactly one result or reaches the end of
  52 # queue.
  53 sub get_next_result {
  54         for (0 .. $njobs - 1) {
  55                 my $result = $result_queues[$next_to_dequeue]->dequeue;
  56                 $next_to_dequeue = ($next_to_dequeue + 1) % $njobs;
  57                 return $result if defined $result;
  58         }
  59         # All queues have ended.
  60         $_->join foreach @tester_threads;
  61         return undef;
  62 }
  63
  64 1;