Abstract our internal capture_stderr test routine

Will need it for even more tests later on, but not sufficiently often to warrant depending on Capture::Tiny - just go with what we need
Perl5 · Jul 25, 2016 · 20c0d57 · 20c0d57
1 parent a8eaf44
commit 20c0d57
Show file tree

Hide file tree

Showing 3 changed files with 40 additions and 47 deletions.
diff --git a/t/35exception_inaction.t b/t/35exception_inaction.t
@@ -12,9 +12,7 @@ BEGIN {
   }
 }
 
-use DBICTest::Util 'tmpdir';
-use File::Temp ();
-use DBIx::Class::_Util 'scope_guard';
+use DBICTest::Util 'capture_stderr';
 use DBIx::Class::Schema;
 
 # Do not use T::B - the test is hard enough not to segfault as it is
@@ -41,34 +39,17 @@ sub ok {
   return !!$_[0];
 }
 
-# yes, make it even dirtier
-my $schema = 'DBIx::Class::Schema';
-
-$schema->connection('dbi:SQLite::memory:');
 
 # this is incredibly horrible...
 # demonstrate utter breakage of the reconnection/retry logic
 #
-open(my $stderr_copy, '>&', *STDERR) or die "Unable to dup STDERR: $!";
-my $tf = File::Temp->new( UNLINK => 1, DIR => tmpdir() );
-
-my $output;
-
+my $output = capture_stderr {
 ESCAPE:
 {
-  my $guard = scope_guard {
-    close STDERR;
-    open(STDERR, '>&', $stderr_copy);
-    $output = do { local (@ARGV, $/) = $tf; <> };
-    close $tf;
-    unlink $tf;
-    undef $tf;
-    close $stderr_copy;
-  };
-
-  close STDERR;
-  open(STDERR, '>&', $tf) or die "Unable to reopen STDERR: $!";
+  # yes, make it even dirtier
+  my $schema = 'DBIx::Class::Schema';
 
+  $schema->connection('dbi:SQLite::memory:');
   $schema->storage->ensure_connected;
   $schema->storage->_dbh->disconnect;
 
@@ -88,7 +69,7 @@ ESCAPE:
 
   # NEITHER will this
   ok(0, "Nope");
-}
+}};
 
 ok(1, "Post-escape reached");
 

diff --git a/t/36double_destroy.t b/t/36double_destroy.t
@@ -4,16 +4,11 @@ use strict;
 use warnings;
 
 use Test::More;
-use File::Temp ();
 
-use DBICTest::Util 'tmpdir';
-use DBIx::Class::_Util 'scope_guard';
+use DBICTest::Util 'capture_stderr';
 
 use DBICTest;
 
-open(my $stderr_copy, '>&', *STDERR) or die "Unable to dup STDERR: $!";
-my $tf = File::Temp->new( UNLINK => 1, DIR => tmpdir() );
-
 my $output;
 
 # ensure Devel::StackTrace-refcapture-like effects are countered
@@ -35,22 +30,9 @@ my $output;
     1;
   }
 
-  my $guard = scope_guard {
-    close STDERR;
-    open(STDERR, '>&', $stderr_copy);
-    $output = do { local (@ARGV, $/) = $tf; <> };
-    close $tf;
-    unlink $tf;
-    undef $tf;
-    close $stderr_copy;
-  };
-
-  close STDERR;
-  open(STDERR, '>&', $tf) or die "Unable to reopen STDERR: $!";
-
   # this should emit on stderr
-  @arg_capture = ();
-}
+  $output = capture_stderr { @arg_capture = () };
+};
 
 like(
   $output,

diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm
@@ -41,7 +41,7 @@ use base 'Exporter';
 our @EXPORT_OK = qw(
   dbg stacktrace class_seems_loaded
   local_umask slurp_bytes tmpdir find_co_root rm_rf
-  PEEPEENESS
+  capture_stderr PEEPEENESS
   check_customcond_args
   await_flock DEBUG_TEST_CONCURRENCY_LOCKS
 );
@@ -273,6 +273,36 @@ EOE
   };
 }
 
+sub capture_stderr (&) {
+  open(my $stderr_copy, '>&', *STDERR) or croak "Unable to dup STDERR: $!";
+
+  require File::Temp;
+  my $tf = File::Temp->new( UNLINK => 1, DIR => tmpdir() );
+
+  my $err_out;
+
+  {
+    my $guard = scope_guard {
+      close STDERR;
+
+      open(STDERR, '>&', $stderr_copy) or do {
+        my $msg = "\n\nPANIC!!!\nFailed restore of STDERR: $!\n";
+        print $stderr_copy $msg;
+        print STDOUT $msg;
+        die;
+      };
+
+      close $stderr_copy;
+    };
+
+    close STDERR;
+    open( STDERR, '>&', $tf );
+
+    $_[0]->();
+  }
+
+  slurp_bytes( "$tf" );
+}
 
 sub slurp_bytes ($) {
   croak "Expecting a file name, not a filehandle" if openhandle $_[0];