fix(test): capture raw test output and prevent leak of debug messages

cpanfile

@@ -10,6 +10,7 @@ on test => sub {
     requires 'Test::More';
     requires 'Test::Exception';
     requires 'Test::Pod';
+    requires 'Test::Output';
 };
 
 feature 'ci' => sub {

lib/Mojo/IOLoop/ReadWriteProcess/Session.pm

@@ -10,6 +10,7 @@ our @EXPORT_OK = qw(session);
 use Exporter 'import';
 
 use Config;
+use Scalar::Util 'weaken';
 
 use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG};
 
@@ -101,6 +102,7 @@ sub add_collected_info {
 sub register {
   my ($process, $pid) = (pop, pop);
   $singleton->process_table()->{$pid} = \$process;
+  weaken($process);
   $singleton->emit(register => $process);
 }
 
@@ -119,18 +121,29 @@ sub orphan  { _resolve(orphans       => pop()) }
 sub resolve { _resolve(process_table => pop()) }
 
 sub clean {
-  $_[0]->resolve($_)->stop() and $_[0]->resolve($_)->DESTROY()
-    for keys %{$_[0]->process_table()};
-  $_[0]->orphan($_)->stop() and $_[0]->orphan($_)->DESTROY()
-    for keys %{$_[0]->orphans()};
-  shift->reset();
+  my $self = shift;
+  for (keys %{$self->process_table()}) {
+    if (my $p = $self->resolve($_)) {
+      $p->stop();
+      $p->DESTROY();
+    }
+  }
+  for (keys %{$self->orphans()}) {
+    if (my $o = $self->orphan($_)) {
+      $o->stop();
+      $o->DESTROY();
+    }
+  }
+  $self->reset();
 }
 
 sub all { c($singleton->all_processes, $singleton->all_orphans)->flatten }
 sub all_orphans { c(values %{$singleton->orphans}) }
 
 sub all_processes {
-  c(values %{$singleton->process_table})->map(sub { ${$_} });
+  c(values %{$singleton->process_table})
+    ->map(sub { ${$_} })
+    ->grep(sub { defined });
 }
 
 sub contains {

t/01_run.t

@@ -4,6 +4,7 @@ use warnings;
 use strict;
 use Test::More;
 use Test::Exception;
+use Test::Output;
 use POSIX;
 use FindBin;
 use IO::Select;
@@ -471,19 +472,21 @@ subtest 'process code()' => sub {
 
 # XXX: flaky test temporarly skip it. is !!$p->exit_status, 1, 'Exit status is there';
 
-  $p = Mojo::IOLoop::ReadWriteProcess->new(
-    kill_sleeptime        => $interval,
-    sleeptime_during_kill => $interval,
-    separate_err          => 0,
-    set_pipes             => 0,
-    code                  => sub {
-      print "TEST normal print\n";
-      print STDERR "TEST error print\n";
-      return "256";
-    })->start();
-  is $p->getline, undef, 'no output from pipes expected';
-  is $p->getline, undef, 'no output from pipes expected';
-  $p->wait_stop();
+  my $captured = combined_from {
+    $p = Mojo::IOLoop::ReadWriteProcess->new(
+      kill_sleeptime        => $interval,
+      sleeptime_during_kill => $interval,
+      separate_err          => 0,
+      set_pipes             => 0,
+      code                  => sub {
+        print "TEST normal print\n";
+        print STDERR "TEST error print\n";
+        return "256";
+      })->start();
+    is $p->getline, undef, 'no output from pipes expected';
+    is $p->getline, undef, 'no output from pipes expected';
+    $p->wait_stop();
+  };
   is $p->return_status, 256, "grab exit_status even if no pipes are set";
 
   $p = Mojo::IOLoop::ReadWriteProcess->new(
@@ -578,41 +581,41 @@ subtest stop_whole_process_group_gracefully => sub {
 };
 
 subtest process_debug => sub {
-  my $buffer;
   local $ENV{MOJO_PROCESS_DEBUG} = 1;
 
   {
-# We have to unload and load it back from memory to enable debug. (the ENV value is considered only in compile-time)
-    open my $handle, '>', \$buffer;
-    local *STDERR = $handle;
+    no warnings 'redefine';
     delete $INC{'Mojo/IOLoop/ReadWriteProcess.pm'};
-    eval "no warnings; require Mojo::IOLoop::ReadWriteProcess";    ## no critic
+    require Mojo::IOLoop::ReadWriteProcess;
+  }
+
+  stderr_like {
     Mojo::IOLoop::ReadWriteProcess->new(
       code                  => sub { 1; },
       kill_sleeptime        => $interval,
       sleeptime_during_kill => $interval
     )->start()->stop();
   }
+  qr/Fork: \{/,
+    'setting MOJO_PROCESS_DEBUG to 1 enables debug mode when forking process';
 
-  like $buffer, qr/Fork: \{/,
-    'setting MOJO_PROCESS_DEBUG to 1 enables debug mode when forking
-process';
-
-  undef $buffer;
-  {
-    open my $handle, '>', \$buffer;
-    local *STDERR = $handle;
-    delete $INC{'Mojo/IOLoop/ReadWriteProcess.pm'};
-    eval "no warnings; require Mojo::IOLoop::ReadWriteProcess";    ## no critic
+  stderr_like {
     Mojo::IOLoop::ReadWriteProcess->new(
       execute               => "$FindBin::Bin/data/process_check.sh",
       kill_sleeptime        => $interval,
       sleeptime_during_kill => $interval,
     )->start()->stop();
   }
-
-  like $buffer, qr/Execute: .*process_check.sh/,
+  qr/Execute: .*process_check.sh/,
 'setting MOJO_PROCESS_DEBUG to 1 enables debug mode when executing external process';
+
+  # Reload with DEBUG disabled so subsequent tests are silent
+  local $ENV{MOJO_PROCESS_DEBUG} = 0;
+  {
+    no warnings 'redefine';
+    delete $INC{'Mojo/IOLoop/ReadWriteProcess.pm'};
+    require Mojo::IOLoop::ReadWriteProcess;
+  }
 };
 
 subtest 'process_args' => sub {

t/04_queues.t

@@ -155,7 +155,7 @@ subtest test_3 => sub {
   }
 };
 
-is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all->size,         40);
+is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all->size,         0);
 is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all_orphans->size, 0);
 
 subtest stress_test => sub {

t/09_session.t

@@ -64,9 +64,10 @@ subtest disable => sub {
 subtest reset => sub {
   session->reset;
 
-  session->register(1 => process(sub { }));
-  session->register(2 => process(sub { }));
-  session->register(3 => process(sub { }));
+  my @p = (process(sub { }), process(sub { }), process(sub { }),);
+  session->register(1 => $p[0]);
+  session->register(2 => $p[1]);
+  session->register(3 => $p[2]);
   session->orphans->{5} = 1;
 
   is session->all->size, 4, 'There are 4 processes';
@@ -106,4 +107,31 @@ subtest protect => sub {
 
 };
 
+subtest 'reference cycle leak' => sub {
+  session->clean();
+
+  $MyTestProcess::destroyed = 0;
+  {
+
+    package MyTestProcess;
+    use Mojo::Base 'Mojo::IOLoop::ReadWriteProcess';
+    sub DESTROY { $MyTestProcess::destroyed++; shift->SUPER::DESTROY }
+  }
+
+  {
+    my $p = MyTestProcess->new();
+    session->register(12345 => $p);
+    is session->all_processes->size, 1, 'one process in session';
+  }
+
+  is $MyTestProcess::destroyed, 1,
+    'process was destroyed when going out of scope';
+  is session->all_processes->size, 0, 'session has no active processes';
+
+  # Exercise clean() with undefined process and defined orphan for 100% coverage
+  session->orphans->{54321} = MyTestProcess->new();
+  session->clean();
+  is session->all_processes->size, 0, 'clean cleared everything';
+};
+
 done_testing();