This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add missing flag in change#4892
[perl5.git] / t / op / fork.t
CommitLineData
8d063cd8
LW
1#!./perl
2
7766f137 3# tests for both real and emulated fork()
8d063cd8 4
774d564b 5BEGIN {
6 chdir 't' if -d 't';
93430cb4 7 unshift @INC, '../lib';
774d564b 8 require Config; import Config;
dfdd1393
GS
9 unless ($Config{'d_fork'}
10 or ($^O eq 'MSWin32' and $Config{useithreads}
11 and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/))
12 {
45c0de28 13 print "1..0 # Skip: no fork\n";
774d564b 14 exit 0;
15 }
7766f137 16 $ENV{PERL5LIB} = "../lib";
774d564b 17}
18
7766f137
GS
19$|=1;
20
21undef $/;
22@prgs = split "\n########\n", <DATA>;
23print "1..", scalar @prgs, "\n";
24
25$tmpfile = "forktmp000";
261 while -f ++$tmpfile;
27END { unlink $tmpfile if $tmpfile; }
28
29$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
8d063cd8 30
7766f137
GS
31for (@prgs){
32 my $switch;
33 if (s/^\s*(-\w.*)//){
34 $switch = $1;
35 }
36 my($prog,$expected) = split(/\nEXPECT\n/, $_);
37 $expected =~ s/\n+$//;
38 # results can be in any order, so sort 'em
39 my @expected = sort split /\n/, $expected;
40 open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
41 print TEST $prog, "\n";
42 close TEST or die "Cannot close $tmpfile: $!";
43 my $results;
44 if ($^O eq 'MSWin32') {
45 $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
46 }
47 else {
48 $results = `./perl $switch $tmpfile 2>&1`;
49 }
50 $status = $?;
51 $results =~ s/\n+$//;
52 $results =~ s/at\s+forktmp\d+\s+line/at - line/g;
53 $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g;
54# bison says 'parse error' instead of 'syntax error',
55# various yaccs may or may not capitalize 'syntax'.
56 $results =~ s/^(syntax|parse) error/syntax error/mig;
57 my @results = sort split /\n/, $results;
58 if ( "@results" ne "@expected" ) {
59 print STDERR "PROG: $switch\n$prog\n";
60 print STDERR "EXPECTED:\n$expected\n";
61 print STDERR "GOT:\n$results\n";
62 print "not ";
63 }
64 print "ok ", ++$i, "\n";
65}
66
67__END__
68$| = 1;
8d063cd8 69if ($cid = fork) {
7766f137
GS
70 sleep 1;
71 if ($result = (kill 9, $cid)) {
72 print "ok 2\n";
73 }
74 else {
75 print "not ok 2 $result\n";
76 }
77 sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug
8d063cd8
LW
78}
79else {
8d063cd8
LW
80 print "ok 1\n";
81 sleep 10;
82}
7766f137
GS
83EXPECT
84ok 1
85ok 2
86########
87$| = 1;
88sub forkit {
89 print "iteration $i start\n";
90 my $x = fork;
91 if (defined $x) {
92 if ($x) {
93 print "iteration $i parent\n";
94 }
95 else {
96 print "iteration $i child\n";
97 }
98 }
99 else {
100 print "pid $$ failed to fork\n";
101 }
102}
103while ($i++ < 3) { do { forkit(); }; }
104EXPECT
105iteration 1 start
106iteration 1 parent
107iteration 1 child
108iteration 2 start
109iteration 2 parent
110iteration 2 child
111iteration 2 start
112iteration 2 parent
113iteration 2 child
114iteration 3 start
115iteration 3 parent
116iteration 3 child
117iteration 3 start
118iteration 3 parent
119iteration 3 child
120iteration 3 start
121iteration 3 parent
122iteration 3 child
123iteration 3 start
124iteration 3 parent
125iteration 3 child
126########
127$| = 1;
128fork()
129 ? (print("parent\n"),sleep(1))
130 : (print("child\n"),exit) ;
131EXPECT
132parent
133child
134########
135$| = 1;
136fork()
137 ? (print("parent\n"),exit)
138 : (print("child\n"),sleep(1)) ;
139EXPECT
140parent
141child
142########
143$| = 1;
144@a = (1..3);
145for (@a) {
146 if (fork) {
147 print "parent $_\n";
148 $_ = "[$_]";
149 }
150 else {
151 print "child $_\n";
152 $_ = "-$_-";
153 }
154}
155print "@a\n";
156EXPECT
157parent 1
158child 1
159parent 2
160child 2
161parent 2
162child 2
163parent 3
164child 3
165parent 3
166child 3
167parent 3
168child 3
169parent 3
170child 3
171[1] [2] [3]
172-1- [2] [3]
173[1] -2- [3]
174[1] [2] -3-
175-1- -2- [3]
176-1- [2] -3-
177[1] -2- -3-
178-1- -2- -3-
179########
180use Config;
181$| = 1;
182$\ = "\n";
183fork()
184 ? print($Config{osname} eq $^O)
185 : print($Config{osname} eq $^O) ;
186EXPECT
1871
1881
189########
190$| = 1;
191$\ = "\n";
192fork()
193 ? do { require Config; print($Config::Config{osname} eq $^O); }
194 : do { require Config; print($Config::Config{osname} eq $^O); }
195EXPECT
1961
1971
198########
199$| = 1;
200use Cwd;
201$\ = "\n";
202my $dir;
203if (fork) {
204 $dir = "f$$.tst";
205 mkdir $dir, 0755;
206 chdir $dir;
207 print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent";
208 chdir "..";
209 rmdir $dir;
210}
211else {
212 sleep 2;
213 $dir = "f$$.tst";
214 mkdir $dir, 0755;
215 chdir $dir;
216 print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child";
217 chdir "..";
218 rmdir $dir;
219}
220EXPECT
221ok 1 parent
222ok 1 child
223########
224$| = 1;
225$\ = "\n";
226my $getenv;
227if ($^O eq 'MSWin32') {
228 $getenv = qq[$^X -e "print \$ENV{TST}"];
229}
230else {
231 $getenv = qq[$^X -e 'print \$ENV{TST}'];
232}
35424068 233$ENV{TST} = 'foo';
7766f137
GS
234if (fork) {
235 sleep 1;
35424068
GS
236 print "parent before: " . `$getenv`;
237 $ENV{TST} = 'bar';
238 print "parent after: " . `$getenv`;
7766f137
GS
239}
240else {
35424068
GS
241 print "child before: " . `$getenv`;
242 $ENV{TST} = 'baz';
243 print "child after: " . `$getenv`;
7766f137
GS
244}
245EXPECT
35424068
GS
246child before: foo
247child after: baz
248parent before: foo
249parent after: bar
7766f137
GS
250########
251$| = 1;
252$\ = "\n";
253if ($pid = fork) {
254 waitpid($pid,0);
255 print "parent got $?"
256}
257else {
258 exit(42);
259}
260EXPECT
261parent got 10752
262########
263$| = 1;
264$\ = "\n";
265my $echo = 'echo';
266if ($pid = fork) {
267 waitpid($pid,0);
268 print "parent got $?"
269}
270else {
271 exec("$echo foo");
272}
273EXPECT
274foo
275parent got 0
276########
277if (fork) {
278 die "parent died";
279}
280else {
281 die "child died";
282}
283EXPECT
284parent died at - line 2.
285child died at - line 5.
286########
287if ($pid = fork) {
288 eval { die "parent died" };
289 print $@;
290}
291else {
292 eval { die "child died" };
293 print $@;
294}
295EXPECT
296parent died at - line 2.
297child died at - line 6.
298########
299if (eval q{$pid = fork}) {
300 eval q{ die "parent died" };
301 print $@;
302}
303else {
304 eval q{ die "child died" };
305 print $@;
306}
307EXPECT
308parent died at (eval 2) line 1.
309child died at (eval 2) line 1.
310########
311BEGIN {
312 $| = 1;
313 fork and exit;
314 print "inner\n";
315}
316# XXX In emulated fork(), the child will not execute anything after
317# the BEGIN block, due to difficulties in recreating the parse stacks
318# and restarting yyparse() midstream in the child. This can potentially
319# be overcome by treating what's after the BEGIN{} as a brand new parse.
320#print "outer\n"
321EXPECT
322inner