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