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
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
19 sub check(@) {
20     grep { eval "&$_;1" or $@!~/vendor has not defined POSIX macro/ } @_
21 }       
22
23 my @path_consts = check qw(
24     _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_NAME_MAX
25     _PC_NO_TRUNC _PC_PATH_MAX
26 );
27
28 my @path_consts_terminal = check qw(
29     _PC_MAX_CANON _PC_MAX_INPUT _PC_VDISABLE
30 );
31
32 my @path_consts_fifo = check qw(
33     _PC_PIPE_BUF
34 );
35
36 my @sys_consts = check qw(
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 );
41
42 my $tests = 2 * 3 * @path_consts +
43             2 * 3 * @path_consts_terminal +
44             2 * 3 * @path_consts_fifo +
45                 3 * @sys_consts;
46 plan $tests 
47      ? (tests => $tests) 
48      : (skip_all => "No tests to run on this OS")
49 ;
50
51 my $curdir = File::Spec->curdir;
52
53 my $r;
54
55 # testing fpathconf() on a non-terminal file
56 SKIP: {
57     my $fd = POSIX::open($curdir, O_RDONLY)
58         or skip "could not open current directory ($!)", 3 * @path_consts;
59
60     for my $constant (@path_consts) {
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         }
69     }
70     
71     POSIX::close($fd);
72 }
73
74 # testing pathconf() on a non-terminal file
75 for my $constant (@path_consts) {
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     }
84 }
85
86 SKIP: {
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);
97
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);
109     # testing pathconf() on a terminal file
110     for my $constant (@path_consts_terminal) {
111         $r = eval { pathconf( $TTY, eval "$constant()" ) };
112         is( $@, '', qq[calling pathconf($TTY, $constant)] );
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: {
121     eval { mkfifo($fifo, 0666) }
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()" ) };
130           is( $@, '', "calling fpathconf($fd, $constant) ($fifo)" );
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
149 END {
150     1 while unlink($fifo);
151 }
152
153 # testing sysconf()
154 for my $constant (@sys_consts) {
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     }
163 }
164