#!/usr/bin/perl
# Test whether programs exit upon a single EOF from a tty.
-# Ensure that e.g., cat exits upon a single EOF (^D) from a tty.
+# Ensure that e.g., cat exits upon a single configured EOF from a tty.
# Do the same for all programs that can read stdin,
# require no arguments and that write to standard output.
use strict;
(my $ME = $0) =~ s|.*/||;
+eval { require POSIX; };
+$@
+ and CuSkip::skip "$ME: this script requires Perl's POSIX module\n";
+
+use POSIX qw(:termios_h);
+
# Some older versions of Expect.pm (e.g. 1.07) lack the log_user method,
# so check for that, too.
eval { require Expect; Expect->require_version('1.11') };
$@
and CuSkip::skip "$ME: this script requires Perl's Expect package >=1.11\n";
+# Try to explicitly set eof character in case it's not the usual Ctrl-d
+sub
+set_tty_eof_char ($$)
+{
+ my ($tty, $eof_char) = @_;
+
+ return eval
+ {
+ my $termios = POSIX::Termios->new;
+ my $fd = fileno ($tty);
+ defined $fd
+ or die "no file descriptor for tty";
+ $termios->getattr ($fd)
+ or die "tcgetattr failed: $!";
+ $termios->setcc (VEOF, ord $eof_char);
+ $termios->setattr ($fd, TCSANOW)
+ or die "tcsetattr failed: $!";
+ 1;
+ };
+}
+
{
my $fail = 0;
+ my $eof_char = "\cD";
+ my $eof_name = '^D';
my @stdin_reading_commands = qw(
b2sum
base32
$exp->spawn("$cmd 2> $stderr")
or (warn "$ME: cannot run '$cmd' ($mode): $!\n"),
$fail=1, next;
+ set_tty_eof_char ($exp->slave, $eof_char);
my $found;
if ($with_input)
$echo =~ s/\n$//;
$exp->send($input);
- $exp->send("\cD"); # This is Control-D. FIXME: what if not EOF?
+ $exp->send($eof_char);
$exp->expect (0, '-re', "^$echo\\r?\$");
$found = $exp->expect (1, '-re', "^.+\$");
$found and warn "F: $found: " . $exp->exp_match () . "\n";
}
else
{
- $exp->send("\cD"); # This is Control-D. FIXME: what if not EOF?
+ $exp->send($eof_char);
}
$exp->expect(10, 'eof');
defined $exp->exitstatus
- or (warn "$ME: $cmd didn't exit after ^D from standard input"
+ or (warn "$ME: $cmd didn't exit after $eof_name from standard input"
. " ($mode)\n"),
$fail=1, next;
my $s = $exp->exitstatus;