This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
RE: Win2k / Cygwin-1.3.3
[perl5.git] / ext / POSIX / t / posix.t
CommitLineData
a0d0e21e
LW
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
a0d0e21e 6 require Config; import Config;
fa6b8193 7 if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
c764b42b 8 print "1..0\n";
a0d0e21e
LW
9 exit 0;
10 }
11}
c07a80fd 12
212caf55
TS
13use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write
14 errno);
a0d0e21e
LW
15use strict subs;
16
c07a80fd 17$| = 1;
212caf55 18print "1..29\n";
a0d0e21e 19
6dead956 20$Is_W32 = $^O eq 'MSWin32';
2986a63f 21$Is_NetWare = $^O eq 'NetWare';
6bbf1b34 22$Is_Dos = $^O eq 'dos';
c9ff6e92 23$Is_MPE = $^O eq 'mpeix';
d536870a 24$Is_MacOS = $^O eq 'MacOS';
6dead956 25
c07a80fd 26$testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n";
a0d0e21e 27read($testfd, $buffer, 9) if $testfd > 2;
c07a80fd 28print $buffer eq "#!./perl\n" ? "ok 2\n" : "not ok 2\n";
29
30write(1,"ok 3\nnot ok 3\n", 5);
a0d0e21e 31
6bbf1b34
LM
32if ($Is_Dos) {
33 for (4..5) {
34 print "ok $_ # skipped, no pipe() support on dos\n";
35 }
36} else {
10de532f
JH
37 @fds = POSIX::pipe();
38 print $fds[0] > $testfd ? "ok 4\n" : "not ok 4\n";
39 CORE::open($reader = \*READER, "<&=".$fds[0]);
40 CORE::open($writer = \*WRITER, ">&=".$fds[1]);
41 print $writer "ok 5\n";
42 close $writer;
43 print <$reader>;
44 close $reader;
6bbf1b34 45}
a0d0e21e 46
6bbf1b34 47if ($Is_W32 || $Is_Dos) {
6dead956 48 for (6..11) {
6bbf1b34 49 print "ok $_ # skipped, no sigaction support on win32/dos\n";
6dead956
GS
50 }
51}
52else {
10de532f
JH
53 $sigset = new POSIX::SigSet 1, 3;
54 delset $sigset 1;
55 if (!ismember $sigset 1) { print "ok 6\n" }
56 if ( ismember $sigset 3) { print "ok 7\n" }
57
58 if ($Is_MacOS) {
59 for (8..11) {
60 print "ok $_ # skipped, no kill() support on Mac OS\n";
61 }
d536870a 62 }
10de532f
JH
63 else {
64 $mask = new POSIX::SigSet &SIGINT;
65 $action = new POSIX::SigAction 'main::SigHUP', $mask, 0;
66 sigaction(&SIGHUP, $action);
67 $SIG{'INT'} = 'SigINT';
68 kill 'HUP', $$;
69 sleep 1;
70 print "ok 11\n";
71
72 sub SigHUP {
73 print "ok 8\n";
74 kill 'INT', $$;
75 sleep 2;
76 print "ok 9\n";
77 }
78
79 sub SigINT {
80 print "ok 10\n";
81 }
d536870a 82 }
6dead956 83}
a0d0e21e 84
c9ff6e92
JH
85if ($Is_MPE) {
86 print "ok 12 # skipped, _POSIX_OPEN_MAX is inaccurate on MPE\n"
87} else {
d536870a
JH
88 if (&_POSIX_OPEN_MAX) {
89 print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n";
90 } else {
91 print "ok 12 # _POSIX_OPEN_MAX undefined ($fds[1])\n";
92 }
c9ff6e92 93}
a0d0e21e 94
d536870a
JH
95my $pat;
96if ($Is_MacOS) {
97 $pat = qr/:t:$/;
98} else {
79b7b35c 99 $pat = qr#[\\/]t$#i;
d536870a
JH
100}
101print getcwd() =~ $pat ? "ok 13\n" : "not ok 13\n";
a0d0e21e 102
a89d8a78
DH
103# Check string conversion functions.
104
105if ($Config{d_strtod}) {
ff68c719 106 $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
a89d8a78 107 ($n, $x) = &POSIX::strtod('3.14159_OR_SO');
ad9fea34 108# we're just checking that strtod works, not how accurate it is
7f82cce9 109 print ((abs("3.14159" - $n) < 1e-6) && ($x == 6) ?
56dd5b29 110 "ok 14\n" : "not ok 14\n");
ff68c719 111 &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale};
a89d8a78
DH
112} else { print "# strtod not present\n", "ok 14\n"; }
113
114if ($Config{d_strtol}) {
115 ($n, $x) = &POSIX::strtol('21_PENGUINS');
116 print (($n == 21) && ($x == 9) ? "ok 15\n" : "not ok 15\n");
117} else { print "# strtol not present\n", "ok 15\n"; }
118
119if ($Config{d_strtoul}) {
120 ($n, $x) = &POSIX::strtoul('88_TEARS');
121 print (($n == 88) && ($x == 6) ? "ok 16\n" : "not ok 16\n");
122} else { print "# strtoul not present\n", "ok 16\n"; }
123
a0d0e21e 124# Pick up whether we're really able to dynamically load everything.
a89d8a78 125print &POSIX::acos(1.0) == 0.0 ? "ok 17\n" : "not ok 17\n";
a0d0e21e 126
84ef74c4
AD
127# This can coredump if struct tm has a timezone field and we
128# didn't detect it. If this fails, try adding
129# -DSTRUCT_TM_HASZONE to your cflags when compiling ext/POSIX/POSIX.c.
130# See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl
131print POSIX::strftime("ok 18 # %H:%M, on %D\n", localtime());
132
33c0e3ec
SB
133# If that worked, validate the mini_mktime() routine's normalisation of
134# input fields to strftime().
135sub try_strftime {
136 my $num = shift;
137 my $expect = shift;
138 my $got = POSIX::strftime("%a %b %d %H:%M:%S %Y %j", @_);
139 if ($got eq $expect) {
140 print "ok $num\n";
141 }
142 else {
143 print "# expected: $expect\n# got: $got\nnot ok $num\n";
144 }
145}
146
147$lc = &POSIX::setlocale(&POSIX::LC_TIME, 'C') if $Config{d_setlocale};
148try_strftime(19, "Wed Feb 28 00:00:00 1996 059", 0,0,0, 28,1,96);
149try_strftime(20, "Thu Feb 29 00:00:60 1996 060", 60,0,-24, 30,1,96);
150try_strftime(21, "Fri Mar 01 00:00:00 1996 061", 0,0,-24, 31,1,96);
151try_strftime(22, "Sun Feb 28 00:00:00 1999 059", 0,0,0, 28,1,99);
152try_strftime(23, "Mon Mar 01 00:00:00 1999 060", 0,0,24, 28,1,99);
153try_strftime(24, "Mon Feb 28 00:00:00 2000 059", 0,0,0, 28,1,100);
154try_strftime(25, "Tue Feb 29 00:00:00 2000 060", 0,0,0, 0,2,100);
155try_strftime(26, "Wed Mar 01 00:00:00 2000 061", 0,0,0, 1,2,100);
d0e85dce 156try_strftime(27, "Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100);
33c0e3ec
SB
157&POSIX::setlocale(&POSIX::LC_TIME, $lc) if $Config{d_setlocale};
158
212caf55
TS
159{
160 for my $test (0, 1) {
161 $! = 0;
162 # POSIX::errno is autoloaded.
163 # Autoloading requires many system calls.
164 # errno() looks at $! to generate its result.
165 # Autoloading should not munge the value.
166 my $foo = $!;
167 my $errno = POSIX::errno();
168 print "not " unless $errno == $foo;
169 print "ok ", 28 + $test, "\n";
170 }
171}
172
c07a80fd 173$| = 0;
10de532f
JH
174# The following line assumes buffered output, which may be not true:
175print '@#!*$@(!@#$' unless ($Is_MacOS || $^O eq 'os2' ||
176 $^O eq 'uwin' || $^O eq 'os390' ||
601f2d16
SB
177 (defined $ENV{PERLIO} &&
178 $ENV{PERLIO} eq 'unix' &&
179 $Config::Config{useperlio}));
a0d0e21e 180_exit(0);