This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skip tests for pathconf() and fpathconf() on HP-UX for
[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
39 _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
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
JH
50
51my $curdir = File::Spec->curdir;
6e32c255
AT
52
53my $r;
54
220f811a 55# testing fpathconf() on a non-terminal file
6e32c255 56SKIP: {
220f811a
JH
57 my $fd = POSIX::open($curdir, O_RDONLY)
58 or skip "could not open current directory ($!)", 3 * @path_consts;
6e32c255
AT
59
60 for my $constant (@path_consts) {
3b44a84e
SP
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
JH
70
71 POSIX::close($fd);
6e32c255
AT
72}
73
220f811a 74# testing pathconf() on a non-terminal file
6e32c255 75for my $constant (@path_consts) {
3b44a84e
SP
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
AT
84}
85
220f811a 86SKIP: {
c6f58167
JH
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
JH
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
JH
109 # testing pathconf() on a terminal file
110 for my $constant (@path_consts_terminal) {
c6f58167
JH
111 $r = eval { pathconf( $TTY, eval "$constant()" ) };
112 is( $@, '', qq[calling pathconf($TTY, $constant)] );
220f811a
JH
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
118my $fifo = "fifo$$";
119
120SKIP: {
60e845e3 121 eval { mkfifo($fifo, 0666) }
220f811a
JH
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
JH
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
JH
149END {
150 1 while unlink($fifo);
151}
220f811a 152
6e32c255
AT
153# testing sysconf()
154for my $constant (@sys_consts) {
2abaefe1
DD
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
AT
163}
164