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