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         $! = 0;
 157         $r = eval { sysconf( eval "$constant()" ) };
 158         my $s = defined($r) || $! == 0;
 159         is( $@, '', "calling sysconf($constant)" );
 160         ok( $s, "\tchecking that the returned value is defined or that errno is clear: $r $!" );
 161         skip "$constant not implemented on $^O", 1 if $s && !defined($r);
 162         ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
 163     }
 164 }
 165