Commit | Line | Data |
---|---|---|
6e32c255 AT |
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 YO |
19 | sub check(@) { |
20 | grep { eval "&$_;1" or $@!~/vendor has not defined POSIX macro/ } @_ | |
21 | } | |
22 | ||
23 | my @path_consts = check qw( | |
220f811a JH |
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 JH |
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 AT |
34 | ); |
35 | ||
60e845e3 | 36 | my @sys_consts = check qw( |
6e32c255 AT |
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 JH |
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 YO |
46 | plan $tests |
47 | ? (tests => $tests) | |
48 | : (skip_all => "No tests to run on this OS") | |
49 | ; | |
220f811a JH |
50 | |
51 | my $curdir = File::Spec->curdir; | |
44abc943 | 52 | $curdir = VMS::Filespec::fileify($curdir) if $^O eq 'VMS'; |
6e32c255 AT |
53 | |
54 | my $r; | |
55 | ||
44abc943 CB |
56 | sub _check_and_report { |
57 | my ($eval_status, $return_val, $description) = @_; | |
58 | my $success = defined($return_val) || $! == 0; | |
59 | is( $eval_status, '', $description ); | |
60 | ok( $success, "\tchecking that the returned value is defined (" | |
61 | . (defined($return_val) ? "yes, it's $return_val)" : "it isn't)" | |
62 | . " or that errno is clear (" | |
63 | . (!($!+0) ? "it is)" : "it isn't, it's $!)")) | |
64 | ); | |
65 | SKIP: { | |
66 | skip "constant not implemented on $^O or no limit in effect", 1 | |
67 | if $success && !defined($return_val); | |
68 | ok( looks_like_number($return_val), "\tchecking that the returned value looks like a number" ); | |
69 | } | |
70 | } | |
71 | ||
220f811a | 72 | # testing fpathconf() on a non-terminal file |
6e32c255 | 73 | SKIP: { |
220f811a JH |
74 | my $fd = POSIX::open($curdir, O_RDONLY) |
75 | or skip "could not open current directory ($!)", 3 * @path_consts; | |
6e32c255 AT |
76 | |
77 | for my $constant (@path_consts) { | |
44abc943 | 78 | $! = 0; |
3b44a84e | 79 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
44abc943 | 80 | _check_and_report( $@, $r, "calling fpathconf($fd, $constant) " ); |
6e32c255 | 81 | } |
220f811a JH |
82 | |
83 | POSIX::close($fd); | |
6e32c255 AT |
84 | } |
85 | ||
220f811a | 86 | # testing pathconf() on a non-terminal file |
6e32c255 | 87 | for my $constant (@path_consts) { |
44abc943 | 88 | $! = 0; |
3b44a84e | 89 | $r = eval { pathconf( $curdir, eval "$constant()" ) }; |
44abc943 | 90 | _check_and_report( $@, $r, qq[calling pathconf("$curdir", $constant)] ); |
6e32c255 AT |
91 | } |
92 | ||
220f811a | 93 | SKIP: { |
c6f58167 JH |
94 | my $TTY = "/dev/tty"; |
95 | ||
96 | my $n = 2 * 3 * @path_consts_terminal; | |
97 | ||
98 | -c $TTY | |
99 | or skip("$TTY not a character file", $n); | |
100 | open(TTY, $TTY) | |
101 | or skip("failed to open $TTY: $!", $n); | |
102 | -t TTY | |
103 | or skip("TTY ($TTY) not a terminal file", $n); | |
220f811a | 104 | |
c6f58167 JH |
105 | my $fd = fileno(TTY); |
106 | ||
107 | # testing fpathconf() on a terminal file | |
108 | for my $constant (@path_consts_terminal) { | |
44abc943 | 109 | $! = 0; |
c6f58167 | 110 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
44abc943 | 111 | _check_and_report( $@, $r, qq[calling fpathconf($fd, $constant) ($TTY)] ); |
c6f58167 JH |
112 | } |
113 | ||
114 | close($fd); | |
220f811a JH |
115 | # testing pathconf() on a terminal file |
116 | for my $constant (@path_consts_terminal) { | |
44abc943 | 117 | $! = 0; |
c6f58167 | 118 | $r = eval { pathconf( $TTY, eval "$constant()" ) }; |
44abc943 | 119 | _check_and_report( $@, $r, qq[calling pathconf($TTY, $constant)] ); |
220f811a JH |
120 | } |
121 | } | |
122 | ||
123 | my $fifo = "fifo$$"; | |
124 | ||
125 | SKIP: { | |
60e845e3 | 126 | eval { mkfifo($fifo, 0666) } |
220f811a JH |
127 | or skip("could not create fifo $fifo ($!)", 2 * 3 * @path_consts_fifo); |
128 | ||
129 | SKIP: { | |
130 | my $fd = POSIX::open($fifo, O_RDWR) | |
131 | or skip("could not open $fifo ($!)", 3 * @path_consts_fifo); | |
132 | ||
133 | for my $constant (@path_consts_fifo) { | |
44abc943 | 134 | $! = 0; |
220f811a | 135 | $r = eval { fpathconf( $fd, eval "$constant()" ) }; |
44abc943 | 136 | _check_and_report( $@, $r, "calling fpathconf($fd, $constant) ($fifo)" ); |
220f811a JH |
137 | } |
138 | ||
139 | POSIX::close($fd); | |
140 | } | |
141 | ||
44abc943 CB |
142 | # testing pathconf() on a fifo file |
143 | for my $constant (@path_consts_fifo) { | |
144 | $! = 0; | |
145 | $r = eval { pathconf( $fifo, eval "$constant()" ) }; | |
146 | _check_and_report( $@, $r, qq[calling pathconf($fifo, $constant)] ); | |
220f811a JH |
147 | } |
148 | } | |
149 | ||
c6f58167 JH |
150 | END { |
151 | 1 while unlink($fifo); | |
152 | } | |
220f811a | 153 | |
6e32c255 AT |
154 | # testing sysconf() |
155 | for my $constant (@sys_consts) { | |
525488d5 | 156 | $! = 0; |
2abaefe1 | 157 | $r = eval { sysconf( eval "$constant()" ) }; |
44abc943 | 158 | _check_and_report( $@, $r, "calling sysconf($constant)" ); |
6e32c255 AT |
159 | } |
160 |