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