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 cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 75 76 $! = 0; 77 is($termios->setattr(fileno $not_a_tty, TCSANOW), undef, 78 'setattr on a non tty should fail'); 79 cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 80} 81 82{ 83 my $t = POSIX::Termios->new(); 84 isa_ok($t, "POSIX::Termios", "checking the type of the object"); 85 86 # B0 is special 87 my @baud = (B50, B75, B110, B134, B150, B200, B300, B600, B1200, B1800, 88 B2400, B4800, B9600, B19200, B38400); 89 90 # On some platforms (eg Linux-that-I-tested), ispeed and ospeed are both 91 # "stored" in the same bits of c_cflag (as the man page documents) 92 # *as well as in struct members* (which you would assume obviates the need 93 # for using c_cflag), and the get*() functions return the value encoded 94 # within c_cflag, hence it's not possible to set/get them independently. 95 foreach my $out (@baud) { 96 is($t->setispeed(0), '0 but true', "setispeed(0)"); 97 is($t->setospeed($out), '0 but true', "setospeed($out)"); 98 is($t->getospeed(), $out, "getospeed() for $out"); 99 } 100 foreach my $in (@baud) { 101 is($t->setospeed(0), '0 but true', "setospeed(0)"); 102 is($t->setispeed($in), '0 but true', "setispeed($in)"); 103 is($t->getispeed(), $in, "getispeed() for $in"); 104 } 105 106 my %state; 107 my @flags = qw(iflag oflag cflag lflag); 108 # I'd prefer to use real values per flag, but can only find OPOST in 109 # POSIX.pm for oflag 110 my @values = (0, 6, 9, 42); 111 112 # initialise everything 113 foreach (@flags) { 114 my $method = 'set' . $_; 115 $t->$method(0); 116 $state{$_} = 0; 117 } 118 119 sub testflags { 120 my ($flag, $values, @rest) = @_; 121 $! = 0; 122 my $method = 'set' . $flag; 123 foreach (@$values) { 124 $t->$method($_); 125 $state{$flag} = $_; 126 127 my $state = join ', ', map {"$_=$state{$_}"} keys %state; 128 while (my ($flag, $expect) = each %state) { 129 my $method = 'get' . $flag; 130 is($t->$method(), $expect, "$method() for $state"); 131 } 132 133 testflags(@rest) if @rest; 134 } 135 } 136 137 testflags(map {($_, \@values)} @flags); 138 139 for my $i (0 .. NCCS-1) { 140 $t->setcc($i, 0); 141 } 142 for my $i (0 .. NCCS-1) { 143 is($t->getcc($i), 0, "getcc($i)"); 144 } 145 my $c = 0; 146 for my $i (0 .. NCCS-1) { 147 $t->setcc($i, ++$c); 148 } 149 for my $i (reverse 0 .. NCCS-1) { 150 is($t->getcc($i), $c--, "getcc($i)"); 151 } 152 for my $i (reverse 0 .. NCCS-1) { 153 $t->setcc($i, ++$c); 154 } 155 for my $i (0 .. NCCS-1) { 156 is($t->getcc($i), $c--, "getcc($i)"); 157 } 158 159} 160 161$! = 0; 162is(tcdrain(fileno $not_a_tty), undef, 'tcdrain on a non tty should fail'); 163cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 164 165$! = 0; 166is(tcflow(fileno $not_a_tty, TCOON), undef, 'tcflow on a non tty should fail'); 167cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 168 169$! = 0; 170is(tcflush(fileno $not_a_tty, TCOFLUSH), undef, 171 'tcflush on a non tty should fail'); 172cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 173 174$! = 0; 175is(tcsendbreak(fileno $not_a_tty, 0), undef, 176 'tcsendbreak on a non tty should fail'); 177cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); 178 179done_testing(); 180