xref: /openbsd-src/gnu/usr.bin/perl/ext/POSIX/t/termios.t (revision 256a93a44f36679bee503f12e49566c2183f6181)

#!perl -Tw

use strict;
use Config;
use Test::More;

BEGIN {
    plan skip_all => "POSIX is unavailable"
	if $Config{extensions} !~ m!\bPOSIX\b!;
}

use POSIX ':termios_h';

plan skip_all => $@
    if !eval "POSIX::Termios->new; 1" && $@ =~ /termios not implemented/;


# A termios struct that we've successfully read from a terminal device:
my $termios;

foreach (undef, qw(STDIN STDOUT STDERR)) {
 SKIP:
    {
	my ($name, $handle);
	if (defined $_) {
	    $name = $_;
	    $handle = $::{$name};
	} else {
	    $name = POSIX::ctermid();
	    skip("Can't get name of controlling terminal", 4)
		unless defined $name;
	    open $handle, '<', $name or skip("can't open $name: $!", 4);
	}

	skip("$name not a tty", 4) unless -t $handle;

	my $t = eval { POSIX::Termios->new };
	is($@, '', "calling POSIX::Termios->new");
	isa_ok($t, "POSIX::Termios", "checking the type of the object");

	my $fileno = fileno $handle;
	my $r = eval { $t->getattr($fileno) };
	is($@, '', "calling getattr($fileno) for $name");
	if(isnt($r, undef, "returned value ($r) is defined")) {
	    $termios = $t;
	}
    }
}

open my $not_a_tty, '<', $^X or die "Can't open $^X: $!";

if (defined $termios) {
    # testing getcc()
    for my $i (0 .. NCCS-1) {
	my $r = eval { $termios->getcc($i) };
	is($@, '', "calling getcc($i)");
	like($r, qr/\A-?[0-9]+\z/, 'returns an integer');
    }
    for my $i (NCCS, ~0) {
	my $r = eval { $termios->getcc($i) };
	like($@, qr/\ABad getcc subscript/, "calling getcc($i)");
	is($r, undef, 'returns undef')
    }

    for my $method (qw(getcflag getiflag getispeed getlflag getoflag getospeed)) {
	my $r = eval { $termios->$method() };
	is($@, '', "calling $method()");
	like($r, qr/\A-?[0-9]+\z/, 'returns an integer');
    }

    $! = 0;
    is($termios->setattr(fileno $not_a_tty), undef,
       'setattr on a non tty should fail');
    {
        # https://bugs.dragonflybsd.org/issues/3252
        local $TODO = "dragonfly returns bad errno"
            if $^O eq 'dragonfly';
        cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY');
    }

    $! = 0;
    is($termios->setattr(fileno $not_a_tty, TCSANOW), undef,
       'setattr on a non tty should fail');
    {
        # https://bugs.dragonflybsd.org/issues/3252
        local $TODO = "dragonfly returns bad errno"
            if $^O eq 'dragonfly';
        cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY');
    }
}

{
    my $t = POSIX::Termios->new();
    isa_ok($t, "POSIX::Termios", "checking the type of the object");

    # B0 is special
    my @baud = (B50, B75, B110, B134, B150, B200, B300, B600, B1200, B1800,
		B2400, B4800, B9600, B19200, B38400);

    # On some platforms (eg Linux-that-I-tested), ispeed and ospeed are both
    # "stored" in the same bits of c_cflag (as the man page documents)
    # *as well as in struct members* (which you would assume obviates the need
    # for using c_cflag), and the get*() functions return the value encoded
    # within c_cflag, hence it's not possible to set/get them independently.
    foreach my $out (@baud) {
	is($t->setispeed(0), '0 but true', "setispeed(0)");
	is($t->setospeed($out), '0 but true', "setospeed($out)");
	is($t->getospeed(), $out, "getospeed() for $out");
    }
    foreach my $in (@baud) {
	is($t->setospeed(0), '0 but true', "setospeed(0)");
	is($t->setispeed($in), '0 but true', "setispeed($in)");
	is($t->getispeed(), $in, "getispeed() for $in");
    }

    my %state;
    my @flags = qw(iflag oflag cflag lflag);
    # I'd prefer to use real values per flag, but can only find OPOST in
    # POSIX.pm for oflag
    my @values = (0, 6, 9, 42);

    # initialise everything
    foreach (@flags) {
	my $method = 'set' . $_;
	$t->$method(0);
	$state{$_} = 0;
    }

    sub testflags {
	my ($flag, $values, @rest) = @_;
	$! = 0;
	my $method = 'set' . $flag;
	foreach (@$values) {
	    $t->$method($_);
	    $state{$flag} = $_;

	    my $state = join ', ', map {"$_=$state{$_}"} keys %state;
	    while (my ($flag, $expect) = each %state) {
		my $method = 'get' . $flag;
		is($t->$method(), $expect, "$method() for $state");
	    }

	    testflags(@rest) if @rest;
	}
    }

    testflags(map {($_, \@values)} @flags);

    for my $i (0 .. NCCS-1) {
	$t->setcc($i, 0);
    }
    for my $i (0 .. NCCS-1) {
	is($t->getcc($i), 0, "getcc($i)");
    }
    my $c = 0;
    for my $i (0 .. NCCS-1) {
	$t->setcc($i, ++$c);
    }
    for my $i (reverse 0 .. NCCS-1) {
	is($t->getcc($i), $c--, "getcc($i)");
    }
    for my $i (reverse 0 .. NCCS-1) {
	$t->setcc($i, ++$c);
    }
    for my $i (0 .. NCCS-1) {
	is($t->getcc($i), $c--, "getcc($i)");
    }

}

$! = 0;
is(tcdrain(fileno $not_a_tty), undef, 'tcdrain on a non tty should fail');
{
    # https://bugs.dragonflybsd.org/issues/3252
    local $TODO = "dragonfly returns bad errno"
        if $^O eq 'dragonfly';
    cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY');
}

$! = 0;
is(tcflow(fileno $not_a_tty, TCOON), undef, 'tcflow on a non tty should fail');
{
    # https://bugs.dragonflybsd.org/issues/3252
    local $TODO = "dragonfly returns bad errno"
        if $^O eq 'dragonfly';
    cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY');
}

$! = 0;
is(tcflush(fileno $not_a_tty, TCOFLUSH), undef,
   'tcflush on a non tty should fail');
{
    # https://bugs.dragonflybsd.org/issues/3252
    local $TODO = "dragonfly returns bad errno"
        if $^O eq 'dragonfly';
    cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY');
}

$! = 0;
is(tcsendbreak(fileno $not_a_tty, 0), undef,
       'tcsendbreak on a non tty should fail');
{
    # https://bugs.dragonflybsd.org/issues/3252
    local $TODO = "dragonfly returns bad errno"
        if $^O eq 'dragonfly';
    cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY');
}

done_testing();