Commit | Line | Data |
6e32c255 |
1 | #!perl -T |
2 | |
3 | BEGIN { |
6e32c255 |
4 | use Config; |
5 | use Test::More; |
6 | plan skip_all => "POSIX is unavailable" if $Config{'extensions'} !~ m!\bPOSIX\b!; |
7 | } |
8 | |
9 | use strict; |
10 | use File::Spec; |
11 | use POSIX; |
12 | use Scalar::Util qw(looks_like_number); |
13 | |
60e845e3 |
14 | sub check(@) { |
15 | grep { eval "&$_;1" or $@!~/vendor has not defined POSIX macro/ } @_ |
16 | } |
17 | |
18 | my @path_consts = check qw( |
220f811a |
19 | _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_NAME_MAX |
20 | _PC_NO_TRUNC _PC_PATH_MAX |
21 | ); |
22 | |
60e845e3 |
23 | my @path_consts_terminal = check qw( |
220f811a |
24 | _PC_MAX_CANON _PC_MAX_INPUT _PC_VDISABLE |
25 | ); |
26 | |
60e845e3 |
27 | my @path_consts_fifo = check qw( |
220f811a |
28 | _PC_PIPE_BUF |
6e32c255 |
29 | ); |
30 | |
60e845e3 |
31 | my @sys_consts = check qw( |
6e32c255 |
32 | _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL |
33 | _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS |
abf8b121 |
34 | _SC_STREAM_MAX _SC_VERSION _SC_TZNAME_MAX |
6e32c255 |
35 | ); |
c6f58167 |
36 | |
37 | my $tests = 2 * 3 * @path_consts + |
38 | 2 * 3 * @path_consts_terminal + |
39 | 2 * 3 * @path_consts_fifo + |
40 | 3 * @sys_consts; |
60e845e3 |
41 | plan $tests |
42 | ? (tests => $tests) |
43 | : (skip_all => "No tests to run on this OS") |
44 | ; |
220f811a |
45 | |
1a5dcd2a |
46 | # Don't test on "." as it can be networked storage which returns EINVAL |
47 | # Testing on "/" may not be portable to non-Unix as it may not be readable |
48 | # "/tmp" should be readable and likely also local. |
49 | my $testdir = File::Spec->tmpdir; |
50 | $testdir = VMS::Filespec::fileify($testdir) if $^O eq 'VMS'; |
6e32c255 |
51 | |
52 | my $r; |
53 | |
9487c2fc |
54 | my $TTY = "/dev/tty"; |
55 | |
44abc943 |
56 | sub _check_and_report { |
57 | my ($eval_status, $return_val, $description) = @_; |
58 | my $success = defined($return_val) || $! == 0; |
59 | is( $eval_status, '', $description ); |
9487c2fc |
60 | SKIP: { |
61 | skip "terminal constants set errno on QNX", 1 |
62 | if $^O eq 'nto' and $description =~ $TTY; |
63 | ok( $success, "\tchecking that the returned value is defined (" |
64 | . (defined($return_val) ? "yes, it's $return_val)" : "it isn't)" |
65 | . " or that errno is clear (" |
66 | . (!($!+0) ? "it is)" : "it isn't, it's $!)")) |
67 | ); |
68 | } |
44abc943 |
69 | SKIP: { |
70 | skip "constant not implemented on $^O or no limit in effect", 1 |
9487c2fc |
71 | if !defined($return_val); |
44abc943 |
72 | ok( looks_like_number($return_val), "\tchecking that the returned value looks like a number" ); |
73 | } |
74 | } |
75 | |
220f811a |
76 | # testing fpathconf() on a non-terminal file |
6e32c255 |
77 | SKIP: { |
1a5dcd2a |
78 | my $fd = POSIX::open($testdir, O_RDONLY) |
79 | or skip "could not open test directory '$testdir' ($!)", |
80 | 3 * @path_consts; |
6e32c255 |
81 | |
82 | for my $constant (@path_consts) { |
44abc943 |
83 | $! = 0; |
3b44a84e |
84 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
44abc943 |
85 | _check_and_report( $@, $r, "calling fpathconf($fd, $constant) " ); |
6e32c255 |
86 | } |
220f811a |
87 | |
88 | POSIX::close($fd); |
6e32c255 |
89 | } |
90 | |
220f811a |
91 | # testing pathconf() on a non-terminal file |
6e32c255 |
92 | for my $constant (@path_consts) { |
44abc943 |
93 | $! = 0; |
1a5dcd2a |
94 | $r = eval { pathconf( $testdir, eval "$constant()" ) }; |
95 | _check_and_report( $@, $r, qq[calling pathconf("$testdir", $constant)] ); |
6e32c255 |
96 | } |
97 | |
220f811a |
98 | SKIP: { |
c6f58167 |
99 | my $n = 2 * 3 * @path_consts_terminal; |
100 | |
101 | -c $TTY |
102 | or skip("$TTY not a character file", $n); |
103 | open(TTY, $TTY) |
104 | or skip("failed to open $TTY: $!", $n); |
105 | -t TTY |
106 | or skip("TTY ($TTY) not a terminal file", $n); |
220f811a |
107 | |
c6f58167 |
108 | my $fd = fileno(TTY); |
109 | |
110 | # testing fpathconf() on a terminal file |
111 | for my $constant (@path_consts_terminal) { |
44abc943 |
112 | $! = 0; |
c6f58167 |
113 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
44abc943 |
114 | _check_and_report( $@, $r, qq[calling fpathconf($fd, $constant) ($TTY)] ); |
c6f58167 |
115 | } |
116 | |
117 | close($fd); |
220f811a |
118 | # testing pathconf() on a terminal file |
119 | for my $constant (@path_consts_terminal) { |
44abc943 |
120 | $! = 0; |
c6f58167 |
121 | $r = eval { pathconf( $TTY, eval "$constant()" ) }; |
44abc943 |
122 | _check_and_report( $@, $r, qq[calling pathconf($TTY, $constant)] ); |
220f811a |
123 | } |
124 | } |
125 | |
126 | my $fifo = "fifo$$"; |
127 | |
128 | SKIP: { |
60e845e3 |
129 | eval { mkfifo($fifo, 0666) } |
220f811a |
130 | or skip("could not create fifo $fifo ($!)", 2 * 3 * @path_consts_fifo); |
131 | |
132 | SKIP: { |
133 | my $fd = POSIX::open($fifo, O_RDWR) |
134 | or skip("could not open $fifo ($!)", 3 * @path_consts_fifo); |
135 | |
136 | for my $constant (@path_consts_fifo) { |
44abc943 |
137 | $! = 0; |
220f811a |
138 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
44abc943 |
139 | _check_and_report( $@, $r, "calling fpathconf($fd, $constant) ($fifo)" ); |
220f811a |
140 | } |
141 | |
142 | POSIX::close($fd); |
143 | } |
144 | |
44abc943 |
145 | # testing pathconf() on a fifo file |
146 | for my $constant (@path_consts_fifo) { |
147 | $! = 0; |
148 | $r = eval { pathconf( $fifo, eval "$constant()" ) }; |
149 | _check_and_report( $@, $r, qq[calling pathconf($fifo, $constant)] ); |
220f811a |
150 | } |
151 | } |
152 | |
c6f58167 |
153 | END { |
154 | 1 while unlink($fifo); |
155 | } |
220f811a |
156 | |
abf8b121 |
157 | SKIP: { |
158 | if($^O eq 'cygwin') { |
159 | pop @sys_consts; |
160 | skip("No _SC_TZNAME_MAX on Cygwin", 3); |
161 | } |
162 | |
163 | } |
6e32c255 |
164 | # testing sysconf() |
165 | for my $constant (@sys_consts) { |
525488d5 |
166 | $! = 0; |
2abaefe1 |
167 | $r = eval { sysconf( eval "$constant()" ) }; |
44abc943 |
168 | _check_and_report( $@, $r, "calling sysconf($constant)" ); |
6e32c255 |
169 | } |
170 | |