1#!/usr/bin/perl
2# Test whether programs exit upon a single EOF from a tty.
3# Ensure that e.g., cat exits upon a single EOF (^D) from a tty.
4# Do the same for all programs that can read stdin,
5# require no arguments and that write to standard output.
6
7# Copyright (C) 2003-2023 Free Software Foundation, Inc.
8
9# This program is free software: you can redistribute it and/or modify
10# it under the terms of the GNU General Public License as published by
11# the Free Software Foundation, either version 3 of the License, or
12# (at your option) any later version.
13
14# This program is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17# GNU General Public License for more details.
18
19# You should have received a copy of the GNU General Public License
20# along with this program.  If not, see <https://www.gnu.org/licenses/>.
21
22use strict;
23(my $ME = $0) =~ s|.*/||;
24
25# Some older versions of Expect.pm (e.g. 1.07) lack the log_user method,
26# so check for that, too.
27eval { require Expect; Expect->require_version('1.11') };
28$@
29  and CuSkip::skip "$ME: this script requires Perl's Expect package >=1.11\n";
30
31{
32  my $fail = 0;
33  my @stdin_reading_commands = qw(
34    b2sum
35    base32
36    base64
37    cat
38    cksum
39    dd
40    expand
41    fmt
42    fold
43    head
44    md5sum
45    nl
46    od
47    paste
48    pr
49    ptx
50    sha1sum
51    sha224sum
52    sha256sum
53    sha384sum
54    sha512sum
55    shuf
56    sort
57    sum
58    tac
59    tail
60    tee
61    tsort
62    unexpand
63    uniq
64    wc
65  );
66  my $stderr = 'tty-eof.err';
67  foreach my $cmd ((@stdin_reading_commands), 'basenc --z85', 'cut -f2',
68                   'numfmt --invalid=ignore')
69    {
70      my $exp = new Expect;
71      $exp->log_user(0);
72      my $cmd_name = (split(' ', $cmd))[0];
73      $ENV{built_programs} =~ /\b$cmd_name\b/ || next;
74      $exp->spawn("$cmd 2> $stderr")
75        or (warn "$ME: cannot run '$cmd': $!\n"), $fail=1, next;
76      # Test cut in a different mode, even though it supports the standard flow
77      # Ensure that it exits with no input as it used to not do so
78      $cmd =~ /^cut/
79        or $exp->send("a b\n");
80      $exp->send("\cD");  # This is Control-D.  FIXME: what if that's not EOF?
81      $cmd =~ /^cut/
82        or $exp->expect (0, '-re', "^a b\\r?\$");
83      $cmd =~ /^cut/
84        or my $found = $exp->expect (1, '-re', "^.+\$");
85      $found and warn "F: $found: " . $exp->exp_match () . "\n";
86      $exp->expect(10, 'eof');
87      # Expect no output from cut, since we gave it no input.
88      defined $found || $cmd =~ /^cut/
89        or (warn "$ME: $cmd didn't produce expected output\n"),
90          $fail=1, next;
91      defined $exp->exitstatus
92        or (warn "$ME: $cmd didn't exit after ^D from standard input\n"),
93          $fail=1, next;
94      my $s = $exp->exitstatus;
95      $s == 0
96        or (warn "$ME: $cmd exited with status $s (expected 0)\n"),
97          $fail=1;
98      $exp->hard_close();
99
100      # dd normally writes to stderr.  If it exits successfully, we're done.
101      $cmd eq 'dd' && $s == 0
102        and next;
103
104      if (-s $stderr)
105        {
106          warn "$ME: $cmd wrote to stderr:\n";
107          system "cat $stderr";
108          $fail = 1;
109        }
110    }
111  continue
112    {
113      unlink $stderr
114        or warn "$ME: failed to remove stderr file from $cmd, $stderr: $!\n";
115    }
116
117  exit $fail
118}
119