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 13BEGIN { require "./test.pl"; } 14plan(tests => 66); 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 lose 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 %m/%d/%y\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); 189SKIP: { 190 skip("VC++ 8 and Vista's CRTs regard 60 seconds as an invalid parameter", 1) 191 if ($Is_W32 and (($Config{cc} eq 'cl' and 192 $Config{ccversion} =~ /^(\d+)/ and $1 >= 14) or 193 (Win32::GetOSVersion())[1] >= 6)); 194 195 try_strftime("Thu Feb 29 00:00:60 1996 060", 60,0,-24, 30,1,96); 196} 197try_strftime("Fri Mar 01 00:00:00 1996 061", 0,0,-24, 31,1,96); 198try_strftime("Sun Feb 28 00:00:00 1999 059", 0,0,0, 28,1,99); 199try_strftime("Mon Mar 01 00:00:00 1999 060", 0,0,24, 28,1,99); 200try_strftime("Mon Feb 28 00:00:00 2000 059", 0,0,0, 28,1,100); 201try_strftime("Tue Feb 29 00:00:00 2000 060", 0,0,0, 0,2,100); 202try_strftime("Wed Mar 01 00:00:00 2000 061", 0,0,0, 1,2,100); 203try_strftime("Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100); 204&POSIX::setlocale(&POSIX::LC_TIME, $lc) if $Config{d_setlocale}; 205 206{ 207 for my $test (0, 1) { 208 $! = 0; 209 # POSIX::errno is autoloaded. 210 # Autoloading requires many system calls. 211 # errno() looks at $! to generate its result. 212 # Autoloading should not munge the value. 213 my $foo = $!; 214 my $errno = POSIX::errno(); 215 216 # Force numeric context. 217 is( $errno + 0, $foo + 0, 'autoloading and errno() mix' ); 218 } 219} 220 221SKIP: { 222 skip("no kill() support on Mac OS", 1) if $Is_MacOS; 223 is (eval "kill 0", 0, "check we have CORE::kill") 224 or print "\$\@ is " . _qq($@) . "\n"; 225} 226 227# Check that we can import the POSIX kill routine 228POSIX->import ('kill'); 229my $result = eval "kill 0"; 230is ($result, undef, "we should now have POSIX::kill"); 231# Check usage. 232like ($@, qr/^Usage: POSIX::kill\(pid, sig\)/, "check its usage message"); 233 234# Check unimplemented. 235$result = eval {POSIX::offsetof}; 236is ($result, undef, "offsetof should fail"); 237like ($@, qr/^Unimplemented: POSIX::offsetof\(\) is C-specific/, 238 "check its unimplemented message"); 239 240# Check reimplemented. 241$result = eval {POSIX::fgets}; 242is ($result, undef, "fgets should fail"); 243like ($@, qr/^Use method IO::Handle::gets\(\) instead/, 244 "check its redef message"); 245 246# Simplistic tests for the isXXX() functions (bug #16799) 247ok( POSIX::isalnum('1'), 'isalnum' ); 248ok(!POSIX::isalnum('*'), 'isalnum' ); 249ok( POSIX::isalpha('f'), 'isalpha' ); 250ok(!POSIX::isalpha('7'), 'isalpha' ); 251ok( POSIX::iscntrl("\cA"),'iscntrl' ); 252ok(!POSIX::iscntrl("A"), 'iscntrl' ); 253ok( POSIX::isdigit('1'), 'isdigit' ); 254ok(!POSIX::isdigit('z'), 'isdigit' ); 255ok( POSIX::isgraph('@'), 'isgraph' ); 256ok(!POSIX::isgraph(' '), 'isgraph' ); 257ok( POSIX::islower('l'), 'islower' ); 258ok(!POSIX::islower('L'), 'islower' ); 259ok( POSIX::isupper('U'), 'isupper' ); 260ok(!POSIX::isupper('u'), 'isupper' ); 261ok( POSIX::isprint('$'), 'isprint' ); 262ok(!POSIX::isprint("\n"), 'isprint' ); 263ok( POSIX::ispunct('%'), 'ispunct' ); 264ok(!POSIX::ispunct('u'), 'ispunct' ); 265ok( POSIX::isspace("\t"), 'isspace' ); 266ok(!POSIX::isspace('_'), 'isspace' ); 267ok( POSIX::isxdigit('f'), 'isxdigit' ); 268ok(!POSIX::isxdigit('g'), 'isxdigit' ); 269# metaphysical question : what should be returned for an empty string ? 270# anyway this shouldn't segfault (bug #24554) 271ok( POSIX::isalnum(''), 'isalnum empty string' ); 272ok( POSIX::isalnum(undef),'isalnum undef' ); 273# those functions should stringify their arguments 274ok(!POSIX::isalpha([]), 'isalpha []' ); 275ok( POSIX::isprint([]), 'isprint []' ); 276 277eval { use strict; POSIX->import("S_ISBLK"); my $x = S_ISBLK }; 278unlike( $@, qr/Can't use string .* as a symbol ref/, "Can import autoloaded constants" ); 279 280# Check that output is not flushed by _exit. This test should be last 281# in the file, and is not counted in the total number of tests. 282if ($^O eq 'vos') { 283 print "# TODO - hit VOS bug posix-885 - _exit flushes output buffers.\n"; 284} else { 285 $| = 0; 286 # The following line assumes buffered output, which may be not true: 287 print '@#!*$@(!@#$' unless ($Is_MacOS || $Is_OS2 || $Is_UWin || $Is_OS390 || 288 $Is_VMS || 289 (defined $ENV{PERLIO} && 290 $ENV{PERLIO} eq 'unix' && 291 $Config::Config{useperlio})); 292 _exit(0); 293} 294