bad readline() returns empty string; expected undef

[jkeenan]

Consider the following program, which is adapted from t/op/readline.t in the Perl 5 core distribution and which appears to have been in core since fd2c61bcfdb in July 2010.

$ cat bad-readline.t 
use strict;
use warnings;
use Test::More;

# [perl #72720] Test that sv_gets clears any variables that should be
# empty so if the read() aborts with EINTER, the TARG is actually
# cleared.
sub test_eintr_readline {
    my ( $fh, $timeout ) = @_;

    # This variable, the TARG for the readline is the core of this
    # test. The test is to see that after a my() and a failure in
    # readline() has the variable revived old, "dead" values from the
    # past or is it still undef like expected.
    my $line;

    # Do a readline into $line.
    if ( $timeout ) {

        # Do a SIGALARM aborted readline(). The underlying sv_gets()
        # from sv.c will use the syscall read() while will exit early
        # and return something like EINTR or ERESTARTSYS.
        my $timed_out;
        my $errno;
        eval {
            local $SIG{ALRM} = sub {
                $timed_out = 1;
                die 'abort this timeout';
            };
            alarm $timeout;
            undef $!;
            $line = readline $fh;
            $errno = $!;
            alarm 0;
        };
    
        # The code should have timed out.
        if ( ! $timed_out ) {
            warn $@
                    ? "$@: $errno\n"
                    : "Interrupted readline() test couldn't get interrupted: $errno";
        }
    }
    else {
        $line = readline $fh;
    }
    return $line;
}

SKIP: {

    # Connect two handles together.
    my ( $in, $out );
    my $piped;
    eval {
        pipe $in, $out;
        $piped = 1;
    };
    if ( ! $piped ) {
        skip( 2, 'The pipe function is unimplemented' );
    }

    # Make the pipe autoflushing
    {
        my $old_fh = select $out;
        $| = 1;
        select $old_fh;
    }

    # Only one line is loaded into the pipe. It's written unbuffered
    # so I'm confident it'll not be buffered.
    syswrite $out, "once\n";

    # Buggy perls will return the last thing successfully
    # returned. Buggy perls will return "once\n" a second (and
    # "infinitely" if we desired) as long as the internal read()
    # syscall fails. In our case, it fails because the inner my($line)
    # retains all its allocated space and buggy perl sets SvPOK to
    # make the value valid but before it starts read().
    my $once  = test_eintr_readline( $in, 0 );
    my $twice = test_eintr_readline( $in, 1 );
    is( $once,  "once\n", "readline read first line ok" );

    TODO: {
        local our $TODO = "bad readline returns '', not undef";
        is( $twice, undef,   "readline didn't return first line again" );
    }
}

done_testing();

We run the program.

$ perl bad-readline.t 
ok 1 - readline read first line ok
not ok 2 - readline didn't return first line again # TODO bad readline returns '', not undef
#   Failed (TODO) test 'readline didn't return first line again'
#   at bad-readline.t line 86.
#          got: ''
#     expected: undef
1..2

So we have a failing, TODO-ed test -- but I couldn't locate any bug ticket corresponding to it. (https://github.com/Perl/perl5/issues?q=is%3Aopen+in%3Atitle+readline+)

Hence, opening this ticket.

Thank you very much.
Jim Keenan