153 lines
5.0 KiB
Diff
153 lines
5.0 KiB
Diff
From d8b61909479178ddb668ad385988877d26f202f2 Mon Sep 17 00:00:00 2001
|
|
From: James E Keenan <jkeenan@cpan.org>
|
|
Date: Thu, 31 Aug 2017 22:57:06 -0400
|
|
Subject: [PATCH] Term::ReadLine generates empty &STDERR files
|
|
MIME-Version: 1.0
|
|
Content-Type: text/plain; charset=UTF-8
|
|
Content-Transfer-Encoding: 8bit
|
|
|
|
Revert to 2-arg open in one case.
|
|
|
|
If /dev/tty is inaccessible, redirecting file handles to STDERR:
|
|
|
|
open (my $fh, ">&STDERR))
|
|
|
|
... cannot be done as a 3 arg open or it'll actually try to write to that
|
|
file.
|
|
|
|
Bump $Term::ReadLine::VERSION.
|
|
Add unit test for RT #132008
|
|
|
|
For: RT #132008
|
|
(cherry picked from commit e4dc68d725b19f46c6fca9423e6e7a0eaeff47f4)
|
|
Signed-off-by: Nicolas R <atoomic@cpan.org>
|
|
|
|
xx
|
|
|
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
---
|
|
MANIFEST | 1 +
|
|
dist/Term-ReadLine/lib/Term/ReadLine.pm | 17 +++++++++-----
|
|
dist/Term-ReadLine/t/ReadLine-STDERR.t | 41 +++++++++++++++++++++++++++++++++
|
|
3 files changed, 53 insertions(+), 6 deletions(-)
|
|
create mode 100644 dist/Term-ReadLine/t/ReadLine-STDERR.t
|
|
|
|
diff --git a/MANIFEST b/MANIFEST
|
|
index ad24a2d28b..180fd4f543 100644
|
|
--- a/MANIFEST
|
|
+++ b/MANIFEST
|
|
@@ -3669,6 +3669,7 @@ dist/Term-ReadLine/lib/Term/ReadLine.pm Stub readline library
|
|
dist/Term-ReadLine/t/AE.t See if Term::ReadLine works
|
|
dist/Term-ReadLine/t/AETk.t See if Term::ReadLine works
|
|
dist/Term-ReadLine/t/ReadLine.t See if Term::ReadLine works
|
|
+dist/Term-ReadLine/t/ReadLine-STDERR.t See if Term::ReadLine works
|
|
dist/Term-ReadLine/t/Tk.t See if Term::ReadLine works
|
|
dist/Test/lib/Test.pm A simple framework for writing test scripts
|
|
dist/Test/t/05_about_verbose.t See if Test works
|
|
diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
|
|
index 88d5a75877..e00fb376cd 100644
|
|
--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
|
|
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
|
|
@@ -229,12 +229,17 @@ sub readline {
|
|
}
|
|
sub addhistory {}
|
|
|
|
+# used for testing purpose
|
|
+sub devtty { return '/dev/tty' }
|
|
+
|
|
sub findConsole {
|
|
my $console;
|
|
my $consoleOUT;
|
|
|
|
- if ($^O ne 'MSWin32' and -e "/dev/tty") {
|
|
- $console = "/dev/tty";
|
|
+ my $devtty = devtty();
|
|
+
|
|
+ if ($^O ne 'MSWin32' and -e $devtty) {
|
|
+ $console = $devtty;
|
|
} elsif ($^O eq 'MSWin32' or $^O eq 'msys' or -e "con") {
|
|
$console = 'CONIN$';
|
|
$consoleOUT = 'CONOUT$';
|
|
@@ -248,7 +253,7 @@ sub findConsole {
|
|
|
|
$consoleOUT = $console unless defined $consoleOUT;
|
|
$console = "&STDIN" unless defined $console;
|
|
- if ($console eq "/dev/tty" && !open(my $fh, "<", $console)) {
|
|
+ if ($console eq $devtty && !open(my $fh, "<", $console)) {
|
|
$console = "&STDIN";
|
|
undef($consoleOUT);
|
|
}
|
|
@@ -266,11 +271,11 @@ sub new {
|
|
if (@_==2) {
|
|
my($console, $consoleOUT) = $_[0]->findConsole;
|
|
|
|
-
|
|
# the Windows CONIN$ needs GENERIC_WRITE mode to allow
|
|
# a SetConsoleMode() if we end up using Term::ReadKey
|
|
open FIN, (( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? '+<' : '<' ), $console;
|
|
- open FOUT,'>', $consoleOUT;
|
|
+ # RT #132008: Still need 2-arg open here
|
|
+ open FOUT,">$consoleOUT";
|
|
|
|
#OUT->autoflush(1); # Conflicts with debugger?
|
|
my $sel = select(FOUT);
|
|
@@ -319,7 +324,7 @@ sub Features { \%features }
|
|
|
|
package Term::ReadLine; # So late to allow the above code be defined?
|
|
|
|
-our $VERSION = '1.16';
|
|
+our $VERSION = '1.17';
|
|
|
|
my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
|
|
if ($which) {
|
|
diff --git a/dist/Term-ReadLine/t/ReadLine-STDERR.t b/dist/Term-ReadLine/t/ReadLine-STDERR.t
|
|
new file mode 100644
|
|
index 0000000000..f7aa2df925
|
|
--- /dev/null
|
|
+++ b/dist/Term-ReadLine/t/ReadLine-STDERR.t
|
|
@@ -0,0 +1,41 @@
|
|
+#!./perl -w
|
|
+use strict;
|
|
+
|
|
+use Test::More;
|
|
+
|
|
+## unit test for RT 132008 - https://rt.perl.org/Ticket/Display.html?id=132008
|
|
+
|
|
+if ( $^O eq 'MSWin32' || !-e q{/dev/tty} ) {
|
|
+ plan skip_all => "Test not tested on windows or when /dev/tty do not exists";
|
|
+}
|
|
+else {
|
|
+ plan tests => 9;
|
|
+}
|
|
+
|
|
+if ( -e q[&STDERR] ) {
|
|
+ note q[Removing existing file &STDERR];
|
|
+ unlink q[&STDERR] or die q{Cannot remove existing file &STDERR [probably created from a previous run]};
|
|
+}
|
|
+
|
|
+use_ok('Term::ReadLine');
|
|
+can_ok( 'Term::ReadLine::Stub', qw{new devtty findConsole} );
|
|
+
|
|
+is( Term::ReadLine->devtty(), q{/dev/tty} );
|
|
+my @out = Term::ReadLine::Stub::findConsole();
|
|
+is_deeply \@out, [ q{/dev/tty}, q{/dev/tty} ], "findConsole is using /dev/tty";
|
|
+
|
|
+{
|
|
+ no warnings 'redefine';
|
|
+ my $donotexist = q[/this/should/not/exist/hopefully];
|
|
+
|
|
+ ok !-e $donotexist, "File $donotexist does not exist";
|
|
+ local *Term::ReadLine::Stub::devtty = sub { $donotexist };
|
|
+ is( Term::ReadLine->devtty(), $donotexist, "devtty mocked" );
|
|
+
|
|
+ my @out = Term::ReadLine::Stub::findConsole();
|
|
+ is_deeply \@out, [ q{&STDIN}, q{&STDERR} ], "findConsole is using /dev/tty" or diag explain \@out;
|
|
+
|
|
+ ok !-e q[&STDERR], 'file &STDERR do not exist before Term::ReadLine call';
|
|
+ my $tr = Term::ReadLine->new('whatever');
|
|
+ ok !-e q[&STDERR], 'file &STDERR was not created by mistake';
|
|
+}
|
|
--
|
|
2.13.6
|
|
|