1#!perl -Tw 2 3use strict; 4use Config; 5use Test::More; 6 7BEGIN { 8 plan skip_all => "POSIX is unavailable" 9 if $Config{extensions} !~ m!\bPOSIX\b!; 10} 11 12use POSIX ':termios_h'; 13 14plan skip_all => $@ 15 if !eval "POSIX::Termios->new; 1" && $@ =~ /termios not implemented/; 16 17 18# A termios struct that we've successfully read from a terminal device: 19my $termios; 20 21foreach (undef, qw(STDIN STDOUT STDERR)) { 22 SKIP: 23 { 24 my ($name, $handle); 25 if (defined $_) { 26 $name = $_; 27 $handle = $::{$name}; 28 } else { 29 $name = POSIX::ctermid(); 30 skip("Can't get name of controlling terminal", 4) 31 unless defined $name; 32 open $handle, '<', $name or skip("can't open $name: $!", 4); 33 } 34 35 skip("$name not a tty", 4) unless -t $handle; 36 37 my $t = eval { POSIX::Termios->new }; 38 is($@, '', "calling POSIX::Termios->new"); 39 isa_ok($t, "POSIX::Termios", "checking the type of the object"); 40 41 my $fileno = fileno $handle; 42 my $r = eval { $t->getattr($fileno) }; 43 is($@, '', "calling getattr($fileno) for $name"); 44 if(isnt($r, undef, "returned value ($r) is defined")) { 45 $termios = $t; 46 } 47 } 48} 49 50open my $not_a_tty, '<', $^X or die "Can't open $^X: $!"; 51 52if (defined $termios) { 53 # testing getcc() 54 for my $i (0 .. NCCS-1) { 55 my $r = eval { $termios->getcc($i) }; 56 is($@, '', "calling getcc($i)"); 57 like($r, qr/\A-?[0-9]+\z/, 'returns an integer'); 58 } 59 for my $i (NCCS, ~0) { 60 my $r = eval { $termios->getcc($i) }; 61 like($@, qr/\ABad getcc subscript/, "calling getcc($i)"); 62 is($r, undef, 'returns undef') 63 } 64 65 for my $method (qw(getcflag getiflag getispeed getlflag getoflag getospeed)) { 66 my $r = eval { $termios->$method() }; 67 is($@, '', "calling $method()"); 68 like($r, qr/\A-?[0-9]+\z/, 'returns an integer'); 69 } 70 71 $! = 0; 72 is($termios->setattr(fileno $not_a_tty), undef, 73 'setattr on a non tty should fail'); 74 { 75 # https://bugs.dragonflybsd.org/issues/3252 76 local $TODO = "dragonfly returns bad errno" 77 if $^O eq 'dragonfly'; 78 cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 79 } 80 81 $! = 0; 82 is($termios->setattr(fileno $not_a_tty, TCSANOW), undef, 83 'setattr on a non tty should fail'); 84 { 85 # https://bugs.dragonflybsd.org/issues/3252 86 local $TODO = "dragonfly returns bad errno" 87 if $^O eq 'dragonfly'; 88 cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 89 } 90} 91 92{ 93 my $t = POSIX::Termios->new(); 94 isa_ok($t, "POSIX::Termios", "checking the type of the object"); 95 96 # B0 is special 97 my @baud = (B50, B75, B110, B134, B150, B200, B300, B600, B1200, B1800, 98 B2400, B4800, B9600, B19200, B38400); 99 100 # On some platforms (eg Linux-that-I-tested), ispeed and ospeed are both 101 # "stored" in the same bits of c_cflag (as the man page documents) 102 # *as well as in struct members* (which you would assume obviates the need 103 # for using c_cflag), and the get*() functions return the value encoded 104 # within c_cflag, hence it's not possible to set/get them independently. 105 foreach my $out (@baud) { 106 is($t->setispeed(0), '0 but true', "setispeed(0)"); 107 is($t->setospeed($out), '0 but true', "setospeed($out)"); 108 is($t->getospeed(), $out, "getospeed() for $out"); 109 } 110 foreach my $in (@baud) { 111 is($t->setospeed(0), '0 but true', "setospeed(0)"); 112 is($t->setispeed($in), '0 but true', "setispeed($in)"); 113 is($t->getispeed(), $in, "getispeed() for $in"); 114 } 115 116 my %state; 117 my @flags = qw(iflag oflag cflag lflag); 118 # I'd prefer to use real values per flag, but can only find OPOST in 119 # POSIX.pm for oflag 120 my @values = (0, 6, 9, 42); 121 122 # initialise everything 123 foreach (@flags) { 124 my $method = 'set' . $_; 125 $t->$method(0); 126 $state{$_} = 0; 127 } 128 129 sub testflags { 130 my ($flag, $values, @rest) = @_; 131 $! = 0; 132 my $method = 'set' . $flag; 133 foreach (@$values) { 134 $t->$method($_); 135 $state{$flag} = $_; 136 137 my $state = join ', ', map {"$_=$state{$_}"} keys %state; 138 while (my ($flag, $expect) = each %state) { 139 my $method = 'get' . $flag; 140 is($t->$method(), $expect, "$method() for $state"); 141 } 142 143 testflags(@rest) if @rest; 144 } 145 } 146 147 testflags(map {($_, \@values)} @flags); 148 149 for my $i (0 .. NCCS-1) { 150 $t->setcc($i, 0); 151 } 152 for my $i (0 .. NCCS-1) { 153 is($t->getcc($i), 0, "getcc($i)"); 154 } 155 my $c = 0; 156 for my $i (0 .. NCCS-1) { 157 $t->setcc($i, ++$c); 158 } 159 for my $i (reverse 0 .. NCCS-1) { 160 is($t->getcc($i), $c--, "getcc($i)"); 161 } 162 for my $i (reverse 0 .. NCCS-1) { 163 $t->setcc($i, ++$c); 164 } 165 for my $i (0 .. NCCS-1) { 166 is($t->getcc($i), $c--, "getcc($i)"); 167 } 168 169} 170 171$! = 0; 172is(tcdrain(fileno $not_a_tty), undef, 'tcdrain on a non tty should fail'); 173{ 174 # https://bugs.dragonflybsd.org/issues/3252 175 local $TODO = "dragonfly returns bad errno" 176 if $^O eq 'dragonfly'; 177 cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 178} 179 180$! = 0; 181is(tcflow(fileno $not_a_tty, TCOON), undef, 'tcflow on a non tty should fail'); 182{ 183 # https://bugs.dragonflybsd.org/issues/3252 184 local $TODO = "dragonfly returns bad errno" 185 if $^O eq 'dragonfly'; 186 cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 187} 188 189$! = 0; 190is(tcflush(fileno $not_a_tty, TCOFLUSH), undef, 191 'tcflush on a non tty should fail'); 192{ 193 # https://bugs.dragonflybsd.org/issues/3252 194 local $TODO = "dragonfly returns bad errno" 195 if $^O eq 'dragonfly'; 196 cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 197} 198 199$! = 0; 200is(tcsendbreak(fileno $not_a_tty, 0), undef, 201 'tcsendbreak on a non tty should fail'); 202{ 203 # https://bugs.dragonflybsd.org/issues/3252 204 local $TODO = "dragonfly returns bad errno" 205 if $^O eq 'dragonfly'; 206 cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 207} 208 209done_testing(); 210