Commit | Line | Data |
6e32c255 |
1 | #!perl -T |
2 | |
3 | BEGIN { |
4 | if ($ENV{PERL_CORE}) { |
5 | chdir 't'; |
6 | @INC = '../lib'; |
7 | } |
8 | |
9 | use Config; |
10 | use Test::More; |
11 | plan skip_all => "POSIX is unavailable" if $Config{'extensions'} !~ m!\bPOSIX\b!; |
12 | } |
13 | |
14 | use strict; |
15 | use File::Spec; |
16 | use POSIX; |
17 | use Scalar::Util qw(looks_like_number); |
18 | |
60e845e3 |
19 | sub check(@) { |
20 | grep { eval "&$_;1" or $@!~/vendor has not defined POSIX macro/ } @_ |
21 | } |
22 | |
23 | my @path_consts = check qw( |
220f811a |
24 | _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_NAME_MAX |
25 | _PC_NO_TRUNC _PC_PATH_MAX |
26 | ); |
27 | |
60e845e3 |
28 | my @path_consts_terminal = check qw( |
220f811a |
29 | _PC_MAX_CANON _PC_MAX_INPUT _PC_VDISABLE |
30 | ); |
31 | |
60e845e3 |
32 | my @path_consts_fifo = check qw( |
220f811a |
33 | _PC_PIPE_BUF |
6e32c255 |
34 | ); |
35 | |
60e845e3 |
36 | my @sys_consts = check qw( |
6e32c255 |
37 | _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL |
38 | _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS |
39 | _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION |
40 | ); |
c6f58167 |
41 | |
42 | my $tests = 2 * 3 * @path_consts + |
43 | 2 * 3 * @path_consts_terminal + |
44 | 2 * 3 * @path_consts_fifo + |
45 | 3 * @sys_consts; |
60e845e3 |
46 | plan $tests |
47 | ? (tests => $tests) |
48 | : (skip_all => "No tests to run on this OS") |
49 | ; |
220f811a |
50 | |
51 | my $curdir = File::Spec->curdir; |
6e32c255 |
52 | |
53 | my $r; |
54 | |
220f811a |
55 | # testing fpathconf() on a non-terminal file |
6e32c255 |
56 | SKIP: { |
220f811a |
57 | my $fd = POSIX::open($curdir, O_RDONLY) |
58 | or skip "could not open current directory ($!)", 3 * @path_consts; |
6e32c255 |
59 | |
60 | for my $constant (@path_consts) { |
3b44a84e |
61 | SKIP: { |
62 | skip "_PC_CHOWN_RESTRICTED is unreliable on HP-UX", 3 |
63 | if $^O eq "hpux" && $constant eq "_PC_CHOWN_RESTRICTED"; |
64 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
65 | is( $@, '', "calling fpathconf($fd, $constant) " ); |
66 | ok( defined $r, "\tchecking that the returned value is defined: $r" ); |
67 | ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); |
68 | } |
6e32c255 |
69 | } |
220f811a |
70 | |
71 | POSIX::close($fd); |
6e32c255 |
72 | } |
73 | |
220f811a |
74 | # testing pathconf() on a non-terminal file |
6e32c255 |
75 | for my $constant (@path_consts) { |
3b44a84e |
76 | SKIP: { |
77 | skip "_PC_CHOWN_RESTRICTED is unreliable on HP-UX", 3 |
78 | if $^O eq "hpux" && $constant eq "_PC_CHOWN_RESTRICTED"; |
79 | $r = eval { pathconf( $curdir, eval "$constant()" ) }; |
80 | is( $@, '', qq[calling pathconf("$curdir", $constant)] ); |
81 | ok( defined $r, "\tchecking that the returned value is defined: $r" ); |
82 | ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); |
83 | } |
6e32c255 |
84 | } |
85 | |
220f811a |
86 | SKIP: { |
c6f58167 |
87 | my $TTY = "/dev/tty"; |
88 | |
89 | my $n = 2 * 3 * @path_consts_terminal; |
90 | |
91 | -c $TTY |
92 | or skip("$TTY not a character file", $n); |
93 | open(TTY, $TTY) |
94 | or skip("failed to open $TTY: $!", $n); |
95 | -t TTY |
96 | or skip("TTY ($TTY) not a terminal file", $n); |
220f811a |
97 | |
c6f58167 |
98 | my $fd = fileno(TTY); |
99 | |
100 | # testing fpathconf() on a terminal file |
101 | for my $constant (@path_consts_terminal) { |
102 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
103 | is( $@, '', qq[calling fpathconf($fd, $constant) ($TTY)] ); |
104 | ok( defined $r, "\tchecking that the returned value is defined: $r" ); |
105 | ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); |
106 | } |
107 | |
108 | close($fd); |
220f811a |
109 | # testing pathconf() on a terminal file |
110 | for my $constant (@path_consts_terminal) { |
c6f58167 |
111 | $r = eval { pathconf( $TTY, eval "$constant()" ) }; |
112 | is( $@, '', qq[calling pathconf($TTY, $constant)] ); |
220f811a |
113 | ok( defined $r, "\tchecking that the returned value is defined: $r" ); |
114 | ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); |
115 | } |
116 | } |
117 | |
118 | my $fifo = "fifo$$"; |
119 | |
120 | SKIP: { |
60e845e3 |
121 | eval { mkfifo($fifo, 0666) } |
220f811a |
122 | or skip("could not create fifo $fifo ($!)", 2 * 3 * @path_consts_fifo); |
123 | |
124 | SKIP: { |
125 | my $fd = POSIX::open($fifo, O_RDWR) |
126 | or skip("could not open $fifo ($!)", 3 * @path_consts_fifo); |
127 | |
128 | for my $constant (@path_consts_fifo) { |
129 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
c6f58167 |
130 | is( $@, '', "calling fpathconf($fd, $constant) ($fifo)" ); |
220f811a |
131 | ok( defined $r, "\tchecking that the returned value is defined: $r" ); |
132 | ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); |
133 | } |
134 | |
135 | POSIX::close($fd); |
136 | } |
137 | |
138 | SKIP: { |
139 | # testing pathconf() on a fifo file |
140 | for my $constant (@path_consts_fifo) { |
141 | $r = eval { pathconf( $fifo, eval "$constant()" ) }; |
142 | is( $@, '', qq[calling pathconf($fifo, $constant)] ); |
143 | ok( defined $r, "\tchecking that the returned value is defined: $r" ); |
144 | ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); |
145 | } |
146 | } |
147 | } |
148 | |
c6f58167 |
149 | END { |
150 | 1 while unlink($fifo); |
151 | } |
220f811a |
152 | |
6e32c255 |
153 | # testing sysconf() |
154 | for my $constant (@sys_consts) { |
2abaefe1 |
155 | SKIP: { |
156 | skip "Saved IDs broken on Mac OS X (Perl #24122)", 3 |
157 | if $^O eq 'darwin' && $constant eq '_SC_SAVED_IDS'; |
158 | $r = eval { sysconf( eval "$constant()" ) }; |
159 | is( $@, '', "calling sysconf($constant)" ); |
160 | ok( defined $r, "\tchecking that the returned value is defined: $r" ); |
161 | ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); |
162 | } |
6e32c255 |
163 | } |
164 | |