Commit | Line | Data |
---|---|---|
674d0cd9 | 1 | #!perl -Tw |
6e32c255 | 2 | |
6e32c255 | 3 | use strict; |
674d0cd9 NC |
4 | use Config; |
5 | use Test::More; | |
6 | ||
60e845e3 | 7 | BEGIN { |
674d0cd9 NC |
8 | plan skip_all => "POSIX is unavailable" |
9 | if $Config{extensions} !~ m!\bPOSIX\b!; | |
60e845e3 YO |
10 | } |
11 | ||
674d0cd9 | 12 | use POSIX ':termios_h'; |
6e32c255 | 13 | |
674d0cd9 NC |
14 | plan skip_all => $@ |
15 | if !eval "POSIX::Termios->new; 1" && $@ =~ /termios not implemented/; | |
6e32c255 | 16 | |
6e32c255 | 17 | |
4e453fcc NC |
18 | # A termios struct that we've successfully read from a terminal device: |
19 | my $termios; | |
20 | ||
21 | foreach (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 | ||
674d0cd9 | 41 | my $fileno = fileno $handle; |
4e453fcc | 42 | my $r = eval { $t->getattr($fileno) }; |
674d0cd9 | 43 | is($@, '', "calling getattr($fileno) for $name"); |
4e453fcc NC |
44 | if(isnt($r, undef, "returned value ($r) is defined")) { |
45 | $termios = $t; | |
46 | } | |
674d0cd9 | 47 | } |
6e32c255 AT |
48 | } |
49 | ||
65ac2484 NC |
50 | open my $not_a_tty, '<', $^X or die "Can't open $^X: $!"; |
51 | ||
4e453fcc NC |
52 | if (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 | } | |
011985f1 NC |
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 | } | |
6e32c255 | 64 | |
4e453fcc NC |
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 | } | |
65ac2484 NC |
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'); | |
6e32c255 AT |
80 | } |
81 | ||
5118227b NC |
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 | } | |
aabf565f NC |
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); | |
47a9096b NC |
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 | ||
5118227b NC |
159 | } |
160 | ||
8f8f11b5 NC |
161 | $! = 0; |
162 | is(tcdrain(fileno $not_a_tty), undef, 'tcdrain on a non tty should fail'); | |
163 | cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); | |
164 | ||
165 | $! = 0; | |
166 | is(tcflow(fileno $not_a_tty, TCOON), undef, 'tcflow on a non tty should fail'); | |
167 | cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); | |
168 | ||
169 | $! = 0; | |
170 | is(tcflush(fileno $not_a_tty, TCOFLUSH), undef, | |
171 | 'tcflush on a non tty should fail'); | |
172 | cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); | |
173 | ||
174 | $! = 0; | |
175 | is(tcsendbreak(fileno $not_a_tty, 0), undef, | |
176 | 'tcsendbreak on a non tty should fail'); | |
177 | cmp_ok($!, '==', POSIX::ENOTTY, 'and set errno to ENOTTY'); | |
178 | ||
674d0cd9 | 179 | done_testing(); |