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