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