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