1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
#!/usr/bin/perl -w
use strict;
use Test::More;
use Tk;
if ($^O eq 'MSWin32' || $^O eq 'cygwin') {
print "1..0 # skip No real fork on Windows-like systems\n";
exit;
}
plan tests => 3;
my $mw = tkinit;
$mw->geometry("+10+10");
ok Tk::IsParentProcess(), 'This is the parent';
pipe(my($rdr,$wtr));
if (fork == 0) {
close $rdr;
select $wtr; $| = 1; select STDOUT; # autoflush, needed because of POSIX::_exit
print $wtr (Tk::IsParentProcess() ? 'parent' : 'child'), "\n";
print "# Child $$\n";
require POSIX;
POSIX::_exit(0);
}
else {
close $wtr;
print "# Parent $$\n";
}
my $child_result = <$rdr>;
like $child_result, qr{^child}, 'Child is not the parent process';
# Pause to allow child to exit, and to collect the
select undef, undef, undef, 0.5;
$mw->update;
pass 'No segfaults';
__END__
|
