1#!./perl -w 2 3use strict; 4use Test::More; 5use Config; 6 7plan(skip_all => "POSIX is unavailable") 8 unless $Config{extensions} =~ /\bPOSIX\b/; 9 10require POSIX; 11require Symbol; 12require File::Temp; 13 14use constant NOT_HERE => 'this-file-should-not-exist'; 15 16# Object destruction causes the file to be deleted. 17my $temp_fh = File::Temp->new(); 18my $temp_file = $temp_fh->filename; 19 20# localtime and gmtime in time.t. 21# exit, fork, waitpid, sleep in waitpid.t 22# errno in posix.t 23 24is(POSIX::abs(-42), 42, 'abs'); 25is(POSIX::abs(-3.14), 3.14, 'abs'); 26is(POSIX::abs(POSIX::exp(1)), CORE::exp(1), 'abs'); 27is(POSIX::alarm(0), 0, 'alarm'); 28is(eval {POSIX::assert(1); 1}, 1, 'assert(1)'); 29is(eval {POSIX::assert(0); 1}, undef, 'assert(0)'); 30like($@, qr/Assertion failed at/, 'assert throws an error'); 31is(POSIX::atan2(0, 1), 0, 'atan2'); 32is(POSIX::cos(0), 1, 'cos'); 33is(POSIX::exp(0), 1, 'exp'); 34is(POSIX::fabs(-42), 42, 'fabs'); 35is(POSIX::fabs(-3.14), 3.14, 'fabs'); 36 37is(do {local $^W; 38 POSIX::fcntl(Symbol::geniosym(), 0, 0); 39 1; 40 }, 1, 'fcntl'); 41 42SKIP: { 43 # Win32 doesn't like me trying to fstat STDIN. Bothersome thing. 44 skip("Can't open $temp_file: $!", 1) unless open my $fh, '<', $temp_file; 45 46 is_deeply([POSIX::fstat(fileno $fh)], [stat $fh], 'fstat'); 47} 48 49is(POSIX::getegid(), 0 + $), 'getegid'); 50is(POSIX::geteuid(), 0 + $>, 'geteuid'); 51is(POSIX::getgid(), 0 + $(, 'getgid'); 52is(POSIX::getenv('PATH'), $ENV{PATH}, 'getenv'); 53 54SKIP: { 55 my $name = eval {getgrgid $(}; 56 skip("getgrgid not available", 2) unless defined $name; 57 is_deeply([POSIX::getgrgid($()], [CORE::getgrgid($()], "getgrgid($()"); 58 is_deeply([POSIX::getgrnam($name)], [CORE::getgrnam($name)], 59 "getgrnam('$name')"); 60} 61 62cmp_ok((length join ' ', POSIX::getgroups()), '<=', length $), 'getgroups'); 63is(POSIX::getlogin(), CORE::getlogin, 'getlogin'); 64 65SKIP: { 66 skip('getpgrp not available', 1) unless $Config{d_getpgrp}; 67 is(POSIX::getpgrp(), CORE::getpgrp(), 'getpgrp'); 68} 69 70is(POSIX::getpid(), $$, 'getpid'); 71 72SKIP: { 73 my $name = eval {getpwuid $<}; 74 skip('getpwuid not available', 2) unless defined $name; 75 is_deeply([POSIX::getpwuid($<)], [CORE::getpwuid($<)], "getgrgid($<)"); 76 is_deeply([POSIX::getpwnam($name)], [CORE::getpwnam($name)], 77 "getpwnam('$name')"); 78} 79 80SKIP: { 81 skip('STDIN is not a tty', 1) unless -t STDIN; 82 is(POSIX::isatty(*STDIN), 1, 'isatty'); 83} 84 85is(POSIX::getuid(), $<, 'getuid'); 86is(POSIX::log(1), 0, 'log'); 87is(POSIX::pow(2, 31), 0x80000000, 'pow'); 88# usage "printf(pattern, args...)" if @_ < 1; 89 90{ 91 my $buffer; 92 package Capture; 93 use parent 'Tie::StdHandle'; 94 95 sub WRITE { 96 $buffer .= $_[1]; 97 42; 98 } 99 100 package main; 101 tie *STDOUT, 'Capture'; 102 is(POSIX::printf('%s %s%c', 'Hello', 'World', ord "\n"), 42, 'printf'); 103 is($buffer, "Hello World\n", 'captured print output'); 104 untie *STDOUT; 105} 106 107is(do {local $^W; 108 POSIX::rewind(Symbol::geniosym()); 109 1; 110 }, 1, 'rewind'); 111 112is(POSIX::sin(0), 0, 'sin'); 113is(POSIX::sleep(0), 0, 'sleep'); 114is(POSIX::sprintf('%o', 42), '52', 'sprintf'); 115is(POSIX::sqrt(256), 16, 'sqrt'); 116is_deeply([POSIX::stat($temp_file)], [stat $temp_file], 'stat'); 117{ 118 local $! = 2; 119 my $error = "$!"; 120 is(POSIX::strerror(2), $error, 'strerror'); 121} 122 123is(POSIX::strstr('BBFRPRAFPGHPP', 'FP'), 7, 'strstr'); 124SKIP: { 125 my $true; 126 foreach (qw(/bin/true /usr/bin/true)) { 127 if (-x $_) { 128 $true = $_; 129 last; 130 } 131 } 132 skip("Can't find true", 1) unless $true; 133 is(POSIX::system($true), 0, 'system'); 134} 135 136{ 137 my $past = CORE::time; 138 my $present = POSIX::time(); 139 my $future = CORE::time; 140 # Shakes fist at virtual machines 141 cmp_ok($past, '<=', $present, 'time'); 142 cmp_ok($present, '<=', $future, 'time'); 143} 144 145is(POSIX::tolower('Perl Rules'), 'perl rules', 'tolower'); 146is(POSIX::toupper('oi!'), 'OI!', 'toupper'); 147 148is(-e NOT_HERE, undef, NOT_HERE . ' does not exist'); 149 150foreach ([undef, 0, 'chdir', NOT_HERE], 151 [undef, 0, 'chmod', 0, NOT_HERE], 152 ['d_chown', 0, 'chown', 0, 0, NOT_HERE], 153 [undef, undef, 'creat', NOT_HERE . '/crash', 0], 154 ['d_link', 0, 'link', NOT_HERE, 'ouch'], 155 [undef, 0, 'remove', NOT_HERE], 156 [undef, 0, 'rename', NOT_HERE, 'z_zwapp'], 157 [undef, 0, 'remove', NOT_HERE], 158 [undef, 0, 'unlink', NOT_HERE], 159 [undef, 0, 'utime', NOT_HERE, 0, 0], 160 ) { 161 my ($skip, $expect, $name, @args) = @$_; 162 my $func = do {no strict 'refs'; \&{"POSIX::$name"}}; 163 164 SKIP: { 165 skip("$name() is not available", 2) if $skip && !$Config{$skip}; 166 $! = 0; 167 is(&$func(@args), $expect, $name); 168 isnt($!, '', "$name reported an error"); 169 } 170} 171 172{ 173 my $dir = "./HiC_$$"; 174 is(-e $dir, undef, "$dir does not exist"); 175 176 is(POSIX::mkdir($dir, 0755), 1, 'mkdir'); 177 is(-d $dir, 1, "$dir now exists"); 178 179 my $dh = POSIX::opendir($dir); 180 isnt($dh, undef, 'opendir'); 181 182 my @first = POSIX::readdir($dh); 183 is(POSIX::rewinddir($dh), 1, 'rewinddir'); 184 my @second = POSIX::readdir($dh); 185 186 is_deeply(\@first, \@second, 'readdir,rewinddir,readdir'); 187 188 is(POSIX::closedir($dh), 1, 'rewinddir'); 189 190 is(POSIX::rmdir($dir), 1, 'rmdir'); 191 is(-e $dir, undef, "$dir does not exist"); 192} 193 194SKIP: { 195 skip("No \$SIG{USR1} on $^O", 4) unless exists $SIG{USR1}; 196 my $gotit = 0; 197 $SIG{USR1} = sub { $gotit++ }; 198 is(POSIX::kill($$, 'SIGUSR1'), 1, 'kill'); 199 is($gotit, 1, 'got first signal'); 200 is(POSIX::raise('SIGUSR1'), 1, 'raise'); 201 is($gotit, 2, 'got second signal'); 202} 203 204SKIP: { 205 foreach (qw(fork pipe)) { 206 skip("no $_", 8) unless $Config{"d_$_"}; 207 } 208 # die with an uncaught SIGARLM if something goes wrong 209 is(CORE::alarm(60), 0, 'no alarm set previously'); 210 211 is((pipe *STDIN, my $w), 1, 'pipe'); 212 my $pid = POSIX::fork(); 213 fail("fork failed: $!") unless defined $pid; 214 215 if ($pid) { 216 close $w; 217 is(POSIX::getc(*STDIN), '1', 'getc'); 218 is(POSIX::getchar(), '2', 'getchar'); 219 is(POSIX::gets(), "345\n", 'gets'); 220 my $ppid = <STDIN>; 221 chomp $ppid; 222 is($ppid, $$, 'getppid'); 223 is(POSIX::wait(), $pid, 'wait'); 224 is(POSIX::WIFEXITED(${^CHILD_ERROR_NATIVE}), 1, 'child exited cleanly'); 225 is(POSIX::WEXITSTATUS(${^CHILD_ERROR_NATIVE}), 1, 226 'child exited with 1 (the retun value of its close call)'); 227 } else { 228 # Child 229 close *STDIN; 230 print $w "12345\n", POSIX::getppid(), "\n"; 231 POSIX::_exit(close $w); 232 } 233} 234 235my $umask = CORE::umask; 236is(POSIX::umask($umask), $umask, 'umask'); 237 238done_testing(); 239