This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
consolidated VMS patches (from Craig A. Berry
[perl5.git] / t / io / openpid.t
CommitLineData
d91d68c1
RS
1#!./perl
2
3#####################################################################
4#
5# Test for process id return value from open
6# Ronald Schmidt (The Software Path) RonaldWS@software-path.com
7#
8#####################################################################
9
10BEGIN {
11 chdir 't' if -d 't';
12 unshift @INC, '../lib';
c529f79d
CB
13 if ($^O eq 'dos') {
14 print "1..0 # Skip: no multitasking\n";
15 exit 0;
16 }
d91d68c1
RS
17}
18
19
20use FileHandle;
4d61ec05 21use Config;
d91d68c1
RS
22autoflush STDOUT 1;
23$SIG{PIPE} = 'IGNORE';
24
25print "1..10\n";
26
34046536 27$perl = qq[$^X "-I../lib"];
d91d68c1
RS
28
29#
30# commands run 4 perl programs. Two of these programs write a
31# short message to STDOUT and exit. Two of these programs
32# read from STDIN. One reader never exits and must be killed.
33# the other reader reads one line, waits a few seconds and then
34# exits to test the waitpid function.
35#
36$cmd1 = qq/$perl -e "use FileHandle; autoflush STDOUT 1; / .
37 qq/print qq[first process\\n]; sleep 30;"/;
38$cmd2 = qq/$perl -e "use FileHandle; autoflush STDOUT 1; / .
39 qq/print qq[second process\\n]; sleep 30;"/;
40$cmd3 = qq/$perl -e "print <>;"/; # hangs waiting for end of STDIN
41$cmd4 = qq/$perl -e "print scalar <>;"/;
42
43#warn "#$cmd1\n#$cmd2\n#$cmd3\n#$cmd4\n";
44
45# start the processes
46$pid1 = open(FH1, "$cmd1 |") or print "not ";
47print "ok 1\n";
48$pid2 = open(FH2, "$cmd2 |") or print "not ";
49print "ok 2\n";
50$pid3 = open(FH3, "| $cmd3") or print "not ";
51print "ok 3\n";
52$pid4 = open(FH4, "| $cmd4") or print "not ";
53print "ok 4\n";
54
55print "# pids were $pid1, $pid2, $pid3, $pid4\n";
56
4d61ec05
GS
57my $killsig = 'HUP';
58$killsig = 1 unless $Config{sig_name} =~ /\bHUP\b/;
59
d91d68c1
RS
60# get message from first process and kill it
61chomp($from_pid1 = scalar(<FH1>));
62print "# child1 returned [$from_pid1]\nnot "
63 unless $from_pid1 eq 'first process';
64print "ok 5\n";
4d61ec05 65$kill_cnt = kill $killsig, $pid1;
d91d68c1
RS
66print "not " unless $kill_cnt == 1;
67print "ok 6\n";
68
69# get message from second process and kill second process and reader process
70chomp($from_pid2 = scalar(<FH2>));
71print "# child2 returned [$from_pid2]\nnot "
72 unless $from_pid2 eq 'second process';
73print "ok 7\n";
4d61ec05 74$kill_cnt = kill $killsig, $pid2, $pid3;
d91d68c1
RS
75print "not " unless $kill_cnt == 2;
76print "ok 8\n";
77
78# send one expected line of text to child process and then wait for it
79autoflush FH4 1;
80print FH4 "ok 9\n";
f0963acb 81print "ok 9 # skip VMS\n" if $^O eq 'VMS';
d91d68c1
RS
82print "# waiting for process $pid4 to exit\n";
83$reap_pid = waitpid $pid4, 0;
84print "# reaped pid $reap_pid != $pid4\nnot "
34046536 85 unless $reap_pid == $pid4;
d91d68c1 86print "ok 10\n";