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