[PATCH] testcommon: dup original handles via open

[PATCH] testcommon: dup original handles via open

[Eric Wong]

I was surprised when I noticed "local *STDIN = *STDIN" worked,
but that was with Perl 5.28.1.  Unfortunately, we can't rely on
users or testers having such a recent Perl version.  Even worse,
it was silently a no-op on Perl 5.24.1 on Debian 9.x.  So, save
the original handle and manually restore the original via open,
when we're done.
---
 lib/PublicInbox/TestCommon.pm | 27 ++++++++++++++++++++-------
 1 file changed, 20 insertions(+), 7 deletions(-)

diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index 85cda031..d9b21337 100644
--- a/lib/PublicInbox/TestCommon.pm
+++ b/lib/PublicInbox/TestCommon.pm
@@ -67,12 +67,25 @@ sub key2script ($) {
 	'blib/script/'.$key;
 }
 
+my @io_mode = ([ *STDIN{IO}, '<&' ], [ *STDOUT{IO}, '>&' ], [ *STDERR{IO}, '>&' ]);
 sub _prepare_redirects ($) {
 	my ($fhref) = @_;
-	my @x = ([ \*STDIN, '<&' ], [ \*STDOUT, '>&' ], [ \*STDERR, '>&' ]);
-	for (my $fd = 0; $fd <= $#x; $fd++) {
+	my $orig_io = [];
+	for (my $fd = 0; $fd <= $#io_mode; $fd++) {
 		my $fh = $fhref->[$fd] or next;
-		my ($oldfh, $mode) = @{$x[$fd]};
+		my ($oldfh, $mode) = @{$io_mode[$fd]};
+		open my $orig, $mode, $oldfh or die "$$oldfh $mode stash: $!";
+		$orig_io->[$fd] = $orig;
+		open $oldfh, $mode, $fh or die "$$oldfh $mode redirect: $!";
+	}
+	$orig_io;
+}
+
+sub _undo_redirects ($) {
+	my ($orig_io) = @_;
+	for (my $fd = 0; $fd <= $#io_mode; $fd++) {
+		my $fh = $orig_io->[$fd] or next;
+		my ($oldfh, $mode) = @{$io_mode[$fd]};
 		open $oldfh, $mode, $fh or die "$$oldfh $mode redirect: $!";
 	}
 }
@@ -174,14 +187,14 @@ sub run_script ($;$$) {
 			$r == $pid or die "waitpid: expected $pid, got $r";
 		}
 	} else { # localize and run everything in the same process:
-		local *STDIN = *STDIN;
-		local *STDOUT = *STDOUT;
-		local *STDERR = *STDERR;
+		# note: "local *STDIN = *STDIN;" and so forth did not work in
+		# old versions of perl
 		local %ENV = $env ? (%ENV, %$env) : %ENV;
 		local %SIG = %SIG;
 		local $0 = join(' ', @$cmd);
-		_prepare_redirects($fhref);
+		my $orig_io = _prepare_redirects($fhref);
 		_run_sub($sub, $key, \@argv);
+		_undo_redirects($orig_io);
 	}
 
 	# slurp the redirects back into user-supplied strings

Re: [PATCH] testcommon: dup original handles via open

[Eric Wong]

Eric Wong <e@80x24.org> wrote:
> I was surprised when I noticed "local *STDIN = *STDIN" worked,
> but that was with Perl 5.28.1.  Unfortunately, we can't rely on
> users or testers having such a recent Perl version.  Even worse,
> it was silently a no-op on Perl 5.24.1 on Debian 9.x.  So, save
> the original handle and manually restore the original via open,
> when we're done.

Wow, I suck at writing commit messages when sleepy :x
The following is slightly better, at least I hope...

Subject: [PATCH] testcommon: fix run_script for older Perls

Using Perl "open" to dup(2) and save the old handles is required
since "local *STDIN = *STDIN" does not work on old Perls.  Even
worse, this was silently a no-op when tested with Perl 5.24.1 on
Debian 9.x and led to confusing failures in t/httpd-corner.t
lsof(1) tests when t/v2mirror.t was run before it from the same
worker process via t/run.perl.