This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skip some POSIX tests when the thing they are testing is unimplemented
[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 my $tests=2 * 3 * @path_consts +
42                   3 * @path_consts_terminal +
43               2 * 3 * @path_consts_fifo +
44                   3 * @sys_consts;
45 plan $tests 
46      ? (tests => $tests) 
47      : (skip_all => "No tests to run on this OS")
48 ;
49
50 my $curdir = File::Spec->curdir;
51
52 my $r;
53
54 # testing fpathconf() on a non-terminal file
55 SKIP: {
56     my $fd = POSIX::open($curdir, O_RDONLY)
57         or skip "could not open current directory ($!)", 3 * @path_consts;
58
59     for my $constant (@path_consts) {
60         $r = eval { fpathconf( $fd, eval "$constant()" ) };
61         is( $@, '', "calling fpathconf($fd, $constant) " );
62         ok( defined $r, "\tchecking that the returned value is defined: $r" );
63         ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
64     }
65     
66     POSIX::close($fd);
67 }
68
69 # testing pathconf() on a non-terminal file
70 for my $constant (@path_consts) {
71     $r = eval { pathconf( $curdir, eval "$constant()" ) };
72     is( $@, '', qq[calling pathconf("$curdir", $constant)] );
73     ok( defined $r, "\tchecking that the returned value is defined: $r" );
74     ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
75 }
76
77 SKIP: {
78     -c "/dev/tty"
79         or skip("/dev/tty not a character file", 3 * @path_consts_terminal);
80
81     # testing pathconf() on a terminal file
82     for my $constant (@path_consts_terminal) {
83         $r = eval { pathconf( "/dev/tty", eval "$constant()" ) };
84         is( $@, '', qq[calling pathconf("/dev/tty", $constant)] );
85         ok( defined $r, "\tchecking that the returned value is defined: $r" );
86         ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
87     }
88 }
89
90 my $fifo = "fifo$$";
91
92 SKIP: {
93     eval { mkfifo($fifo, 0666) }
94         or skip("could not create fifo $fifo ($!)", 2 * 3 * @path_consts_fifo);
95
96   SKIP: {
97       my $fd = POSIX::open($fifo, O_RDWR)
98           or skip("could not open $fifo ($!)", 3 * @path_consts_fifo);
99
100       for my $constant (@path_consts_fifo) {
101           $r = eval { fpathconf( $fd, eval "$constant()" ) };
102           is( $@, '', "calling fpathconf($fd, $constant) " );
103           ok( defined $r, "\tchecking that the returned value is defined: $r" );
104           ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
105       }
106     
107       POSIX::close($fd);
108   }
109
110   SKIP: {
111       # testing pathconf() on a fifo file
112       for my $constant (@path_consts_fifo) {
113           $r = eval { pathconf( $fifo, eval "$constant()" ) };
114           is( $@, '', qq[calling pathconf($fifo, $constant)] );
115           ok( defined $r, "\tchecking that the returned value is defined: $r" );
116           ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
117       }
118   }
119 }
120
121 unlink($fifo);
122
123 # testing sysconf()
124 for my $constant (@sys_consts) {
125     $r = eval { sysconf( eval "$constant()" ) };
126     is( $@, '', "calling sysconf($constant)" );
127     ok( defined $r, "\tchecking that the returned value is defined: $r" );
128     ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
129 }
130