t/op/fork.t

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