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_VERSION _SC_TZNAME_MAX
  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 # 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.
  54 my $testdir = File::Spec->tmpdir;
  55 $testdir = VMS::Filespec::fileify($testdir) if $^O eq 'VMS';
  56
  57 my $r;
  58
  59 my $TTY = "/dev/tty";
  60
  61 sub _check_and_report {
  62     my ($eval_status, $return_val, $description) = @_;
  63     my $success = defined($return_val) || $! == 0;
  64     is( $eval_status, '', $description );
  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     }
  74     SKIP: {
  75         skip "constant not implemented on $^O or no limit in effect", 1
  76             if !defined($return_val);
  77         ok( looks_like_number($return_val), "\tchecking that the returned value looks like a number" );
  78     }
  79 }
  80
  81 # testing fpathconf() on a non-terminal file
  82 SKIP: {
  83     my $fd = POSIX::open($testdir, O_RDONLY)
  84         or skip "could not open test directory '$testdir' ($!)",
  85           3 * @path_consts;
  86
  87     for my $constant (@path_consts) {
  88             $! = 0;
  89             $r = eval { fpathconf( $fd, eval "$constant()" ) };
  90             _check_and_report( $@, $r, "calling fpathconf($fd, $constant) " );
  91     }
  92
  93     POSIX::close($fd);
  94 }
  95
  96 # testing pathconf() on a non-terminal file
  97 for my $constant (@path_consts) {
  98         $! = 0;
  99         $r = eval { pathconf( $testdir, eval "$constant()" ) };
 100         _check_and_report( $@, $r, qq[calling pathconf("$testdir", $constant)] );
 101 }
 102
 103 SKIP: {
 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);
 112
 113     my $fd = fileno(TTY);
 114
 115     # testing fpathconf() on a terminal file
 116     for my $constant (@path_consts_terminal) {
 117         $! = 0;
 118         $r = eval { fpathconf( $fd, eval "$constant()" ) };
 119         _check_and_report( $@, $r, qq[calling fpathconf($fd, $constant) ($TTY)] );
 120     }
 121
 122     close($fd);
 123     # testing pathconf() on a terminal file
 124     for my $constant (@path_consts_terminal) {
 125         $! = 0;
 126         $r = eval { pathconf( $TTY, eval "$constant()" ) };
 127         _check_and_report( $@, $r, qq[calling pathconf($TTY, $constant)] );
 128     }
 129 }
 130
 131 my $fifo = "fifo$$";
 132
 133 SKIP: {
 134     eval { mkfifo($fifo, 0666) }
 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) {
 142           $! = 0;
 143           $r = eval { fpathconf( $fd, eval "$constant()" ) };
 144           _check_and_report( $@, $r, "calling fpathconf($fd, $constant) ($fifo)" );
 145       }
 146
 147       POSIX::close($fd);
 148   }
 149
 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)] );
 155   }
 156 }
 157
 158 END {
 159     1 while unlink($fifo);
 160 }
 161
 162 SKIP: {
 163     if($^O eq 'cygwin') {
 164         pop @sys_consts;
 165         skip("No _SC_TZNAME_MAX on Cygwin", 3);
 166     }
 167
 168 }
 169 # testing sysconf()
 170 for my $constant (@sys_consts) {
 171         $! = 0;
 172         $r = eval { sysconf( eval "$constant()" ) };
 173         _check_and_report( $@, $r, "calling sysconf($constant)" );
 174 }
 175