From d8b61909479178ddb668ad385988877d26f202f2 Mon Sep 17 00:00:00 2001 From: James E Keenan 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 xx Signed-off-by: Petr Písař --- 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