#!perl -T
BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't';
- @INC = '../lib';
- }
-
use Config;
use Test::More;
plan skip_all => "POSIX is unavailable" if $Config{'extensions'} !~ m!\bPOSIX\b!;
my @sys_consts = check qw(
_SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS
- _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
+ _SC_STREAM_MAX _SC_VERSION _SC_TZNAME_MAX
);
my $tests = 2 * 3 * @path_consts +
: (skip_all => "No tests to run on this OS")
;
-my $curdir = File::Spec->curdir;
+# Don't test on "." as it can be networked storage which returns EINVAL
+# Testing on "/" may not be portable to non-Unix as it may not be readable
+# "/tmp" should be readable and likely also local.
+my $testdir = File::Spec->tmpdir;
+$testdir = VMS::Filespec::fileify($testdir) if $^O eq 'VMS';
my $r;
+my $TTY = "/dev/tty";
+
+sub _check_and_report {
+ my ($eval_status, $return_val, $description) = @_;
+ my $success = defined($return_val) || $! == 0;
+ is( $eval_status, '', $description );
+ SKIP: {
+ skip "terminal constants set errno on QNX", 1
+ if $^O eq 'nto' and $description =~ $TTY;
+ ok( $success, "\tchecking that the returned value is defined ("
+ . (defined($return_val) ? "yes, it's $return_val)" : "it isn't)"
+ . " or that errno is clear ("
+ . (!($!+0) ? "it is)" : "it isn't, it's $!)"))
+ );
+ }
+ SKIP: {
+ skip "constant not implemented on $^O or no limit in effect", 1
+ if !defined($return_val);
+ ok( looks_like_number($return_val), "\tchecking that the returned value looks like a number" );
+ }
+}
+
# testing fpathconf() on a non-terminal file
SKIP: {
- my $fd = POSIX::open($curdir, O_RDONLY)
- or skip "could not open current directory ($!)", 3 * @path_consts;
+ my $fd = POSIX::open($testdir, O_RDONLY)
+ or skip "could not open test directory '$testdir' ($!)",
+ 3 * @path_consts;
for my $constant (@path_consts) {
- SKIP: {
- skip "_PC_CHOWN_RESTRICTED is unreliable on HP-UX", 3
- if $^O eq "hpux" && $constant eq "_PC_CHOWN_RESTRICTED";
+ $! = 0;
$r = eval { fpathconf( $fd, eval "$constant()" ) };
- is( $@, '', "calling fpathconf($fd, $constant) " );
- ok( defined $r, "\tchecking that the returned value is defined: $r" );
- ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
- }
+ _check_and_report( $@, $r, "calling fpathconf($fd, $constant) " );
}
POSIX::close($fd);
# testing pathconf() on a non-terminal file
for my $constant (@path_consts) {
- SKIP: {
- skip "_PC_CHOWN_RESTRICTED is unreliable on HP-UX", 3
- if $^O eq "hpux" && $constant eq "_PC_CHOWN_RESTRICTED";
- $r = eval { pathconf( $curdir, eval "$constant()" ) };
- is( $@, '', qq[calling pathconf("$curdir", $constant)] );
- ok( defined $r, "\tchecking that the returned value is defined: $r" );
- ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
- }
+ $! = 0;
+ $r = eval { pathconf( $testdir, eval "$constant()" ) };
+ _check_and_report( $@, $r, qq[calling pathconf("$testdir", $constant)] );
}
SKIP: {
- my $TTY = "/dev/tty";
-
my $n = 2 * 3 * @path_consts_terminal;
-c $TTY
# testing fpathconf() on a terminal file
for my $constant (@path_consts_terminal) {
+ $! = 0;
$r = eval { fpathconf( $fd, eval "$constant()" ) };
- is( $@, '', qq[calling fpathconf($fd, $constant) ($TTY)] );
- ok( defined $r, "\tchecking that the returned value is defined: $r" );
- ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
+ _check_and_report( $@, $r, qq[calling fpathconf($fd, $constant) ($TTY)] );
}
close($fd);
# testing pathconf() on a terminal file
for my $constant (@path_consts_terminal) {
+ $! = 0;
$r = eval { pathconf( $TTY, eval "$constant()" ) };
- is( $@, '', qq[calling pathconf($TTY, $constant)] );
- ok( defined $r, "\tchecking that the returned value is defined: $r" );
- ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
+ _check_and_report( $@, $r, qq[calling pathconf($TTY, $constant)] );
}
}
or skip("could not open $fifo ($!)", 3 * @path_consts_fifo);
for my $constant (@path_consts_fifo) {
+ $! = 0;
$r = eval { fpathconf( $fd, eval "$constant()" ) };
- is( $@, '', "calling fpathconf($fd, $constant) ($fifo)" );
- ok( defined $r, "\tchecking that the returned value is defined: $r" );
- ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
+ _check_and_report( $@, $r, "calling fpathconf($fd, $constant) ($fifo)" );
}
POSIX::close($fd);
}
- SKIP: {
- # testing pathconf() on a fifo file
- for my $constant (@path_consts_fifo) {
- $r = eval { pathconf( $fifo, eval "$constant()" ) };
- is( $@, '', qq[calling pathconf($fifo, $constant)] );
- ok( defined $r, "\tchecking that the returned value is defined: $r" );
- ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
- }
+ # testing pathconf() on a fifo file
+ for my $constant (@path_consts_fifo) {
+ $! = 0;
+ $r = eval { pathconf( $fifo, eval "$constant()" ) };
+ _check_and_report( $@, $r, qq[calling pathconf($fifo, $constant)] );
}
}
1 while unlink($fifo);
}
+SKIP: {
+ if($^O eq 'cygwin') {
+ pop @sys_consts;
+ skip("No _SC_TZNAME_MAX on Cygwin", 3);
+ }
+
+}
# testing sysconf()
for my $constant (@sys_consts) {
- SKIP: {
$! = 0;
$r = eval { sysconf( eval "$constant()" ) };
- my $s = defined($r) || $! == 0;
- is( $@, '', "calling sysconf($constant)" );
- ok( $s, "\tchecking that the returned value is defined or that errno is clear: $r $!" );
- skip "$constant not implemented on $^O", 1 if $s && !defined($r);
- ok( looks_like_number($r), "\tchecking that the returned value looks like a number" );
- }
+ _check_and_report( $@, $r, "calling sysconf($constant)" );
}
projects / p5sagit/p5-mst-13.2.git / blobdiff