1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
print "1..0\n";
exit 0;
}
}
require "./test.pl";
plan(tests => 65);
use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write
errno);
use strict 'subs';
$| = 1;
$Is_W32 = $^O eq 'MSWin32';
$Is_Dos = $^O eq 'dos';
$Is_MPE = $^O eq 'mpeix';
$Is_MacOS = $^O eq 'MacOS';
$Is_VMS = $^O eq 'VMS';
$Is_OS2 = $^O eq 'os2';
$Is_UWin = $^O eq 'uwin';
$Is_OS390 = $^O eq 'os390';
ok( $testfd = open("TEST", O_RDONLY, 0), 'O_RDONLY with open' );
read($testfd, $buffer, 4) if $testfd > 2;
is( $buffer, "#!./", ' with read' );
TODO:
{
local $TODO = "read to array element not working";
read($testfd, $buffer[1], 5) if $testfd > 2;
is( $buffer[1], "perl\n", ' read to array element' );
}
write(1,"ok 4\nnot ok 4\n", 5);
next_test();
SKIP: {
skip("no pipe() support on DOS", 2) if $Is_Dos;
@fds = POSIX::pipe();
ok( $fds[0] > $testfd, 'POSIX::pipe' );
CORE::open($reader = \*READER, "<&=".$fds[0]);
CORE::open($writer = \*WRITER, ">&=".$fds[1]);
print $writer "ok 6\n";
close $writer;
print <$reader>;
close $reader;
next_test();
}
SKIP: {
skip("no sigaction support on win32/dos", 6) if $Is_W32 || $Is_Dos;
my $sigset = new POSIX::SigSet 1, 3;
$sigset->delset(1);
ok(! $sigset->ismember(1), 'POSIX::SigSet->delset' );
ok( $sigset->ismember(3), 'POSIX::SigSet->ismember' );
SKIP: {
skip("no kill() support on Mac OS", 4) if $Is_MacOS;
my $sigint_called = 0;
my $mask = new POSIX::SigSet &SIGINT;
my $action = new POSIX::SigAction 'main::SigHUP', $mask, 0;
sigaction(&SIGHUP, $action);
$SIG{'INT'} = 'SigINT';
# At least OpenBSD/i386 3.3 is okay, as is NetBSD 1.5.
# But not NetBSD 1.6 & 1.6.1: the test makes perl crash.
# So the kill() must not be done with this config in order to
# finish the test.
# For others (darwin & freebsd), let the test fail without crashing.
my $todo = $^O eq 'netbsd' && $Config{osvers}=~/^1\.6/;
my $why_todo = "# TODO $^O $Config{osvers} seems to loose blocked signals";
if (!$todo) {
kill 'HUP', $$;
} else {
print "not ok 9 - sigaction SIGHUP ",$why_todo,"\n";
print "not ok 10 - sig mask delayed SIGINT ",$why_todo,"\n";
}
sleep 1;
$todo = 1 if ($^O eq 'freebsd')
|| ($^O eq 'darwin' && $Config{osvers} lt '6.6');
printf "%s 11 - masked SIGINT received %s\n",
$sigint_called ? "ok" : "not ok",
$todo ? $why_todo : '';
print "ok 12 - signal masks successful\n";
sub SigHUP {
print "ok 9 - sigaction SIGHUP\n";
kill 'INT', $$;
sleep 2;
print "ok 10 - sig mask delayed SIGINT\n";
}
sub SigINT {
$sigint_called++;
}
# The order of the above tests is very important, so
# we use literal prints and hard coded numbers.
next_test() for 1..4;
}
}
SKIP: {
skip("_POSIX_OPEN_MAX is inaccurate on MPE", 1) if $Is_MPE;
skip("_POSIX_OPEN_MAX undefined ($fds[1])", 1) unless &_POSIX_OPEN_MAX;
ok( &_POSIX_OPEN_MAX >= 16, "The minimum allowed values according to susv2" );
}
my $pat;
if ($Is_MacOS) {
$pat = qr/:t:$/;
}
elsif ( $Is_VMS ) {
$pat = qr/\.T]/i;
}
else {
$pat = qr#[\\/]t$#i;
}
like( getcwd(), qr/$pat/, 'getcwd' );
# Check string conversion functions.
SKIP: {
skip("strtod() not present", 1) unless $Config{d_strtod};
$lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
# we're just checking that strtod works, not how accurate it is
($n, $x) = &POSIX::strtod('3.14159_OR_SO');
ok((abs("3.14159" - $n) < 1e-6) && ($x == 6), 'strtod works');
&POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale};
}
SKIP: {
skip("strtol() not present", 2) unless $Config{d_strtol};
($n, $x) = &POSIX::strtol('21_PENGUINS');
is($n, 21, 'strtol() number');
is($x, 9, ' unparsed chars');
}
SKIP: {
skip("strtoul() not present", 2) unless $Config{d_strtoul};
($n, $x) = &POSIX::strtoul('88_TEARS');
is($n, 88, 'strtoul() number');
is($x, 6, ' unparsed chars');
}
# Pick up whether we're really able to dynamically load everything.
ok( &POSIX::acos(1.0) == 0.0, 'dynamic loading' );
# This can coredump if struct tm has a timezone field and we
# didn't detect it. If this fails, try adding
# -DSTRUCT_TM_HASZONE to your cflags when compiling ext/POSIX/POSIX.c.
# See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl
print POSIX::strftime("ok 21 # %H:%M, on %D\n", localtime());
next_test();
# If that worked, validate the mini_mktime() routine's normalisation of
# input fields to strftime().
sub try_strftime {
my $expect = shift;
my $got = POSIX::strftime("%a %b %d %H:%M:%S %Y %j", @_);
is($got, $expect, "validating mini_mktime() and strftime(): $expect");
}
$lc = &POSIX::setlocale(&POSIX::LC_TIME, 'C') if $Config{d_setlocale};
try_strftime("Wed Feb 28 00:00:00 1996 059", 0,0,0, 28,1,96);
try_strftime("Thu Feb 29 00:00:60 1996 060", 60,0,-24, 30,1,96);
try_strftime("Fri Mar 01 00:00:00 1996 061", 0,0,-24, 31,1,96);
try_strftime("Sun Feb 28 00:00:00 1999 059", 0,0,0, 28,1,99);
try_strftime("Mon Mar 01 00:00:00 1999 060", 0,0,24, 28,1,99);
try_strftime("Mon Feb 28 00:00:00 2000 059", 0,0,0, 28,1,100);
try_strftime("Tue Feb 29 00:00:00 2000 060", 0,0,0, 0,2,100);
try_strftime("Wed Mar 01 00:00:00 2000 061", 0,0,0, 1,2,100);
try_strftime("Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100);
&POSIX::setlocale(&POSIX::LC_TIME, $lc) if $Config{d_setlocale};
{
for my $test (0, 1) {
$! = 0;
# POSIX::errno is autoloaded.
# Autoloading requires many system calls.
# errno() looks at $! to generate its result.
# Autoloading should not munge the value.
my $foo = $!;
my $errno = POSIX::errno();
# Force numeric context.
is( $errno + 0, $foo + 0, 'autoloading and errno() mix' );
}
}
SKIP: {
skip("no kill() support on Mac OS", 1) if $Is_MacOS;
is (eval "kill 0", 0, "check we have CORE::kill")
or print "\$\@ is " . _qq($@) . "\n";
}
# Check that we can import the POSIX kill routine
POSIX->import ('kill');
my $result = eval "kill 0";
is ($result, undef, "we should now have POSIX::kill");
# Check usage.
like ($@, qr/^Usage: POSIX::kill\(pid, sig\)/, "check its usage message");
# Check unimplemented.
$result = eval {POSIX::offsetof};
is ($result, undef, "offsetof should fail");
like ($@, qr/^Unimplemented: POSIX::offsetof\(\) is C-specific/,
"check its unimplemented message");
# Check reimplemented.
$result = eval {POSIX::fgets};
is ($result, undef, "fgets should fail");
like ($@, qr/^Use method IO::Handle::gets\(\) instead/,
"check its redef message");
# Simplistic tests for the isXXX() functions (bug #16799)
ok( POSIX::isalnum('1'), 'isalnum' );
ok(!POSIX::isalnum('*'), 'isalnum' );
ok( POSIX::isalpha('f'), 'isalpha' );
ok(!POSIX::isalpha('7'), 'isalpha' );
ok( POSIX::iscntrl("\cA"),'iscntrl' );
ok(!POSIX::iscntrl("A"), 'iscntrl' );
ok( POSIX::isdigit('1'), 'isdigit' );
ok(!POSIX::isdigit('z'), 'isdigit' );
ok( POSIX::isgraph('@'), 'isgraph' );
ok(!POSIX::isgraph(' '), 'isgraph' );
ok( POSIX::islower('l'), 'islower' );
ok(!POSIX::islower('L'), 'islower' );
ok( POSIX::isupper('U'), 'isupper' );
ok(!POSIX::isupper('u'), 'isupper' );
ok( POSIX::isprint('$'), 'isprint' );
ok(!POSIX::isprint("\n"), 'isprint' );
ok( POSIX::ispunct('%'), 'ispunct' );
ok(!POSIX::ispunct('u'), 'ispunct' );
ok( POSIX::isspace("\t"), 'isspace' );
ok(!POSIX::isspace('_'), 'isspace' );
ok( POSIX::isxdigit('f'), 'isxdigit' );
ok(!POSIX::isxdigit('g'), 'isxdigit' );
# metaphysical question : what should be returned for an empty string ?
# anyway this shouldn't segfault (bug #24554)
ok( POSIX::isalnum(''), 'isalnum empty string' );
ok( POSIX::isalnum(undef),'isalnum undef' );
# those functions should stringify their arguments
ok(!POSIX::isalpha([]), 'isalpha []' );
ok( POSIX::isprint([]), 'isprint []' );
# Check that output is not flushed by _exit. This test should be last
# in the file, and is not counted in the total number of tests.
if ($^O eq 'vos') {
print "# TODO - hit VOS bug posix-885 - _exit flushes output buffers.\n";
} else {
$| = 0;
# The following line assumes buffered output, which may be not true:
print '@#!*$@(!@#$' unless ($Is_MacOS || $Is_OS2 || $Is_UWin || $Is_OS390 ||
$Is_VMS ||
(defined $ENV{PERLIO} &&
$ENV{PERLIO} eq 'unix' &&
$Config::Config{useperlio}));
_exit(0);
}
|