ext/POSIX/t/sysconf.t

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