about summary refs log tree commit homepage
path: root/lib/PublicInbox/TestCommon.pm
diff options
context:
space:
mode:
authorEric Wong <e@80x24.org>2019-12-19 08:38:51 +0000
committerEric Wong <e@80x24.org>2019-12-20 02:40:09 +0000
commit8d29cf132caf3de81986179b10746f31123c96b9 (patch)
treec25c199495a045e097fb88508d7c391fb29c332b /lib/PublicInbox/TestCommon.pm
parent7321c78ebdcaa7ce5f0f8383e07429827da0b718 (diff)
downloadpublic-inbox-8d29cf132caf3de81986179b10746f31123c96b9.tar.gz
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 the t/httpd-corner.t
lsof(1) tests when run after t/v2mirror.t from the same worker
process using t/run.perl.
Diffstat (limited to 'lib/PublicInbox/TestCommon.pm')
-rw-r--r--lib/PublicInbox/TestCommon.pm29
1 files changed, 22 insertions, 7 deletions
diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index 85cda031..2828c0d0 100644
--- a/lib/PublicInbox/TestCommon.pm
+++ b/lib/PublicInbox/TestCommon.pm
@@ -67,12 +67,27 @@ 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 +189,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