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