Collector idle backoff fixes

Changes

@@ -2,6 +2,8 @@
 
     - Add [PruneCruft] to dist.ini so build artifacts (blib/,
       pm_to_blib, MYMETA.*) no longer leak into release tarballs.
+    - Fix the collector pinning a CPU core: it now sleeps between polls
+      instead of busy-looping whenever a job is active.
 
 1.000172  2026-04-28 21:15:51-07:00 America/Los_Angeles
 

lib/Test2/Harness/Collector.pm

@@ -32,10 +32,13 @@ use Test2::Harness::Util::HashBase qw{
     +jobs_file +jobs_queue +jobs_done  +jobs
     +pending
 
-    <wait_time
+    <wait_time <idle_wait
     <action
 };
 
+# Floor of the idle backoff. The ceiling is 'wait_time'.
+sub MIN_WAIT() { 0.001 }
+
 sub init {
     my $self = shift;
 
@@ -47,25 +50,61 @@ sub init {
     $self->{+RUN_DIR} = $run_dir;
 
     $self->{+WAIT_TIME} //= 0.02;
+    $self->{+IDLE_WAIT} = MIN_WAIT;
 
     $self->{+ACTION}->($self->_harness_event(0, undef, time, harness_run => $self->{+RUN}, harness_settings => $self->settings, about => {no_display => 1}));
 }
 
+sub reset_idle_wait {
+    my $self = shift;
+    $self->{+IDLE_WAIT} = MIN_WAIT;
+    return;
+}
+
+# Sleep for the current backoff, then double it up to the 'wait_time' ceiling.
+sub idle_sleep {
+    my $self = shift;
+
+    my $wait = $self->{+IDLE_WAIT};
+    sleep($wait);
+
+    $wait *= 2;
+    my $max = $self->{+WAIT_TIME};
+    $self->{+IDLE_WAIT} = $wait > $max ? $max : $wait;
+
+    return;
+}
+
 sub process {
     my $self = shift;
 
     my %warning_seen;
     my $settings = $self->settings;
 
     while (1) {
+        # $count is the liveness counter that guards loop exit: it also counts
+        # jobs that exist but have produced nothing yet. $work counts events
+        # actually processed, and is the only thing the sleep decision uses.
         my $count = 0;
-        $count += $self->process_runner_output if $self->{+SHOW_RUNNER_OUTPUT};
-        $count += $self->process_tasks();
-
-        my $jobs = $self->jobs;
+        my $work  = 0;
+        $work  += $self->process_runner_output if $self->{+SHOW_RUNNER_OUTPUT};
+        $work  += $self->process_tasks();
+        $count += $work;
+
+        # jobs() emits harness_job_start events for any newly discovered jobs;
+        # that counts as work. It cannot change $count: a new job means %$jobs
+        # is not empty, so the loop below counts it.
+        my $known = keys %{$self->{+JOBS} // {}};
+        my $jobs  = $self->jobs;
+        $work += (keys %$jobs) - $known;
 
         unless (keys %$jobs) {
-            next if $count;
+            if ($count) {
+                # Work was done, so do not sleep, but keep the backoff at its
+                # floor for the next idle iteration.
+                $self->reset_idle_wait;
+                next;
+            }
 
             if ($self->persistent_runner) {
                 last if $self->{+JOBS_DONE};
@@ -84,6 +123,7 @@ sub process {
             }
 
             $count += $e_count;
+            $work  += $e_count;
             next if $e_count;
             my $done = $jdir->done;
             unless ($done) {
@@ -119,7 +159,8 @@ sub process {
         }
 
         last if !$count && $self->runner_exited;
-        sleep $self->{+WAIT_TIME} unless $count;
+
+        $work ? $self->reset_idle_wait : $self->idle_sleep;
     }
 
     # One last slurp

t/unit/Test2/Harness/Collector.t

@@ -0,0 +1,82 @@
+use Test2::V0 -target => 'Test2::Harness::Collector';
+use File::Spec;
+use File::Temp qw/tempdir/;
+use Time::HiRes qw/time/;
+
+use Test2::Harness::Run;
+
+my $tmp    = tempdir(CLEANUP => 1);
+my $run_id = 'test-run';
+mkdir(File::Spec->catdir($tmp, $run_id)) or die "Could not create run dir: $!";
+
+sub new_collector {
+    return $CLASS->new(
+        run     => Test2::Harness::Run->new(run_id => $run_id),
+        workdir => $tmp,
+        run_id  => $run_id,
+        action  => sub { },
+        @_,
+    );
+}
+
+subtest defaults => sub {
+    my $one = new_collector();
+
+    is($one->wait_time, 0.02,             "wait_time defaults to 0.02");
+    is($one->idle_wait, $CLASS->MIN_WAIT, "backoff starts at the floor");
+};
+
+subtest wait_time_is_settable => sub {
+    my $one = new_collector(wait_time => 0.5);
+
+    is($one->wait_time, 0.5, "wait_time can be set by the constructor");
+};
+
+subtest backoff_doubles_and_caps => sub {
+    my $one = new_collector(wait_time => 0.008);
+
+    my @seen;
+    for (1 .. 5) {
+        push @seen => $one->idle_wait;
+        $one->idle_sleep;
+    }
+
+    is(
+        \@seen,
+        [0.001, 0.002, 0.004, 0.008, 0.008],
+        "each sleep doubles the wait until it reaches the wait_time ceiling, then holds"
+    );
+
+    is($one->idle_wait, 0.008, "wait stays at the ceiling");
+};
+
+subtest reset_returns_to_the_floor => sub {
+    my $one = new_collector(wait_time => 0.008);
+
+    $one->idle_sleep for 1 .. 4;
+    is($one->idle_wait, 0.008, "backed off to the ceiling");
+
+    $one->reset_idle_wait;
+    is($one->idle_wait, $CLASS->MIN_WAIT, "reset returns to the floor");
+};
+
+subtest ceiling_below_the_floor_is_honored => sub {
+    my $one = new_collector(wait_time => 0.0005);
+
+    $one->idle_sleep;
+    is($one->idle_wait, 0.0005, "a wait_time under the floor caps the very first backoff");
+};
+
+subtest idle_sleep_actually_sleeps => sub {
+    my $one = new_collector();
+
+    my $start = time;
+    $one->idle_sleep;
+    my $slept = time - $start;
+
+    # Deliberately loose: this asserts that a sleep happens at all, not how
+    # precisely the scheduler honors the requested duration.
+    ok($slept >= 0.0005, "idle_sleep waited", "slept ${slept}s");
+};
+
+done_testing;