xref: /openbsd-src/gnu/usr.bin/perl/cpan/File-Temp/t/fork.t (revision 256a93a44f36679bee503f12e49566c2183f6181)
1b39c5158Smillert#!/usr/bin/perl
2b39c5158Smillert$| = 1;
3b39c5158Smillert
4b39c5158Smillert# Note that because fork loses test count we do not use Test::More
5b39c5158Smillert
6b39c5158Smillertuse strict;
7b39c5158Smillert
8b39c5158SmillertBEGIN {
9b39c5158Smillert  require Config;
10b39c5158Smillert  my $can_fork = $Config::Config{d_fork} ||
11b39c5158Smillert    (($^O eq 'MSWin32' || $^O eq 'NetWare') and
12b39c5158Smillert     $Config::Config{useithreads} and
13b39c5158Smillert     $Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
14b39c5158Smillert    );
15*256a93a4Safresh1  if ( $can_fork && !(($^O eq 'MSWin32') && $Devel::Cover::VERSION) ) {
16b39c5158Smillert    print "1..8\n";
17b39c5158Smillert  } else {
18*256a93a4Safresh1    if ( ($^O eq 'MSWin32') && $Devel::Cover::VERSION ) {
19*256a93a4Safresh1        print "1..0 # Skip Devel::Cover coverage testing is incompatible with fork under 'MSWin32'\n";
20*256a93a4Safresh1    } else {
21b39c5158Smillert        print "1..0 # Skip No fork available\n";
22*256a93a4Safresh1    }
23b39c5158Smillert    exit;
24b39c5158Smillert  }
25b39c5158Smillert}
26b39c5158Smillert
27b39c5158Smillertuse File::Temp;
28b39c5158Smillert
29b39c5158Smillert# OO interface
30b39c5158Smillert
31b39c5158Smillertmy $file = File::Temp->new();
32b39c5158Smillert
33b39c5158Smillertmyok( 1, -f $file->filename, "OO File exists" );
34b39c5158Smillert
35b39c5158Smillertmy $children = 2;
36b39c5158Smillertfor my $i (1 .. $children) {
37b39c5158Smillert  my $pid = fork;
38b39c5158Smillert  die "Can't fork: $!" unless defined $pid;
39b39c5158Smillert  if ($pid) {
40b39c5158Smillert    # parent process
41b39c5158Smillert    next;
42b39c5158Smillert  } else {
43b39c5158Smillert    # in a child we can't keep the count properly so we do it manually
44b39c5158Smillert    # make sure that child 1 dies first
45*256a93a4Safresh1    my $time = ($i-1) * 3;
46b39c5158Smillert    print "# child $i sleeping for $time seconds\n";
47b39c5158Smillert    sleep($time);
48b39c5158Smillert    my $count = $i + 1;
49b39c5158Smillert    myok( $count, -f $file->filename(), "OO file present in child $i" );
50b39c5158Smillert    print "# child $i exiting\n";
51b39c5158Smillert    exit;
52b39c5158Smillert  }
53b39c5158Smillert}
54b39c5158Smillert
55b39c5158Smillertwhile ($children) {
56b39c5158Smillert    wait;
57b39c5158Smillert    $children--;
58b39c5158Smillert}
59b39c5158Smillert
60b39c5158Smillert
61b39c5158Smillert
62b39c5158Smillertmyok( 4, -f $file->filename(), "OO File exists in parent" );
63b39c5158Smillert
64b39c5158Smillert# non-OO interface
65b39c5158Smillert
66b39c5158Smillertmy ($fh, $filename) = File::Temp::tempfile( UNLINK => 1 );
67b39c5158Smillert
68b39c5158Smillertmyok( 5, -f $filename, "non-OO File exists" );
69b39c5158Smillert
70b39c5158Smillert$children = 2;
71b39c5158Smillertfor my $i (1 .. $children) {
72b39c5158Smillert  my $pid = fork;
73b39c5158Smillert  die "Can't fork: $!" unless defined $pid;
74b39c5158Smillert  if ($pid) {
75b39c5158Smillert    # parent process
76b39c5158Smillert    next;
77b39c5158Smillert  } else {
78*256a93a4Safresh1    my $time = ($i-1) * 3;
79b39c5158Smillert    print "# child $i sleeping for $time seconds\n";
80b39c5158Smillert    sleep($time);
81b39c5158Smillert    my $count = 5 + $i;
82b39c5158Smillert    myok( $count, -f $filename, "non-OO File present in child $i" );
83b39c5158Smillert    print "# child $i exiting\n";
84b39c5158Smillert    exit;
85b39c5158Smillert  }
86b39c5158Smillert}
87b39c5158Smillert
88b39c5158Smillertwhile ($children) {
89b39c5158Smillert    wait;
90b39c5158Smillert    $children--;
91b39c5158Smillert}
92b39c5158Smillertmyok(8, -f $filename, "non-OO File exists in parent" );
93b39c5158Smillert
94b39c5158Smillert
95b39c5158Smillert# Local ok sub handles explicit number
96b39c5158Smillertsub myok {
97b39c5158Smillert  my ($count, $test, $msg) = @_;
98b39c5158Smillert
99b39c5158Smillert  if ($test) {
100b39c5158Smillert    print "ok $count - $msg\n";
101b39c5158Smillert  } else {
102b39c5158Smillert    print "not ok $count - $msg\n";
103b39c5158Smillert  }
104b39c5158Smillert  return $test;
105b39c5158Smillert}
106