1#!./perl -w 2use strict; 3 4use Test::More; 5 6## unit test for RT 132008 - https://rt.perl.org/Ticket/Display.html?id=132008 7 8if ( $^O eq 'MSWin32' || !-e q{/dev/tty} ) { 9 plan skip_all => "Not tested on windows or when /dev/tty does not exist"; 10} 11else { 12 plan tests => 9; 13} 14 15if ( -e q[&STDERR] ) { 16 note q[Removing existing file &STDERR]; 17 unlink q[&STDERR] or die q{Cannot remove existing file &STDERR [probably created from a previous run]}; 18} 19 20use_ok('Term::ReadLine'); 21can_ok( 'Term::ReadLine::Stub', qw{new devtty findConsole} ); 22is( Term::ReadLine->devtty(), q{/dev/tty}, "check sub devtty" ); 23SKIP: 24{ 25 open my $tty, "<", Term::ReadLine->devtty() 26 or skip "Cannot open tty", 1; 27 -t $tty 28 or skip "No tty found, so findConsole() won't return /dev/tty", 1; 29 my @out = Term::ReadLine::Stub::findConsole(); 30 is_deeply \@out, [ q{/dev/tty}, q{/dev/tty} ], "findConsole is using /dev/tty"; 31} 32 33{ 34 no warnings 'redefine'; 35 my $donotexist = q[/this/should/not/exist/hopefully]; 36 37 ok !-e $donotexist, "File $donotexist does not exist"; 38 # double mention to prevent warning 39 local *Term::ReadLine::Stub::devtty = 40 *Term::ReadLine::Stub::devtty = sub { $donotexist }; 41 is( Term::ReadLine->devtty(), $donotexist, "devtty mocked" ); 42 43 my @out = Term::ReadLine::Stub::findConsole(); 44 is_deeply \@out, [ q{&STDIN}, q{&STDERR} ], "findConsole isn't using /dev/tty" or diag explain \@out; 45 46 ok !-e q[&STDERR], 'file &STDERR do not exist before Term::ReadLine call'; 47 my $tr = Term::ReadLine->new('whatever'); 48 ok !-e q[&STDERR], 'file &STDERR was not created by mistake'; 49} 50