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