Term-ReadLine-1.17

Author: rurban

MANIFEST

@@ -3873,6 +3873,7 @@ dist/Term-Complete/t/Complete.t		See if Term::Complete works
 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-STDERR.t
 dist/Term-ReadLine/t/ReadLine.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

Porting/Maintainers.pl

@@ -1302,7 +1302,7 @@ package Maintainers;
     },
 
     'Term::ReadLine' => {
-        'DISTRIBUTION' => 'FLORA/Term-ReadLine-1.14.tar.gz',
+        'DISTRIBUTION' => 'FLORA/Term-ReadLine-1.17.tar.gz',
         'FILES'        => q[dist/Term-ReadLine],
         'EXCLUDED'     => [qr{^t/release-.*\.t}],
     },

dist/Module-CoreList/lib/Module/CoreList.pm

@@ -17570,6 +17570,7 @@ our %delta = (
             'Scalar::Util'          => '1.50_11',
             'Sub::Util'             => '1.50_11',
             'Socket'                => '2.027_04',
+            'Term::ReadLine'        => '1.17',
             'XSLoader'              => '1.04c',
         },
         removed => {

dist/Term-ReadLine/lib/Term/ReadLine.pm

@@ -75,6 +75,8 @@ history. Returns the old value.
 returns an array with two strings that give most appropriate names for
 files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">.
 
+The strings returned may not be useful for 3-argument open().
+
 =item Attribs
 
 returns a reference to a hash which describes internal configuration
@@ -229,12 +231,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 +255,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 +273,10 @@ 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" :
-                                                              "<$console";
+    open FIN, (( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? '+<' : '<' ), $console;
+    # RT #132008:  Still need 2-arg open here
     open FOUT,">$consoleOUT";
 
     #OUT->autoflush(1);		# Conflicts with debugger?
@@ -320,7 +326,7 @@ sub Features { \%features }
 
 package Term::ReadLine;		# So late to allow the above code be defined?
 
-our $VERSION = '1.15';
+our $VERSION = '1.17';
 
 my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
 if ($which) {

dist/Term-ReadLine/t/ReadLine-STDERR.t

@@ -0,0 +1,49 @@
+#!./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 => "Not tested on windows or when /dev/tty does not exist";
+}
+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}, "check sub devtty" );
+SKIP:
+{
+    open my $tty, "<",  Term::ReadLine->devtty()
+      or skip "Cannot open tty", 1;
+    -t $tty
+      or skip "No tty found, so findConsole() won't return /dev/tty", 1;
+    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";
+    # double mention to prevent warning
+    local *Term::ReadLine::Stub::devtty =
+      *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 isn't 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';
+}

pod/perlcdelta.pod

@@ -468,6 +468,10 @@ Fixup the new pairmap spill code.
 
 =item L<Socket> 2.027_04
 
+=item L<Term::ReadLine> 1.17
+
+fix for empty &STDERR files, RT #132008
+
 =item L<XSLoader> 1.04c
 
 Fix wrong usage of C<SvREFCNT_inc_simple_NN> with a function, fixes a memory leak.