Commit | Line | Data |
---|---|---|
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 | ||
10 | BEGIN { | |
11 | chdir 't' if -d 't'; | |
f0060996 | 12 | require './test.pl'; |
624c42e2 | 13 | set_up_inc('../lib'); |
d91d68c1 RS |
14 | } |
15 | ||
f0060996 | 16 | plan tests => 10; |
802cb175 | 17 | watchdog(15, $^O eq 'MSWin32' ? "alarm" : ''); |
f0060996 | 18 | |
4d61ec05 | 19 | use Config; |
d27127a1 | 20 | $| = 1; |
d91d68c1 | 21 | $SIG{PIPE} = 'IGNORE'; |
b6811f8d TC |
22 | # reset the handler in case the shell has set a broken default |
23 | $SIG{HUP} = 'DEFAULT'; | |
0c52c6a9 | 24 | $SIG{HUP} = 'IGNORE' if $^O eq 'interix'; |
d91d68c1 | 25 | |
f0060996 | 26 | my $perl = which_perl(); |
c8fc8fb0 | 27 | $perl .= qq[ "-I../lib"]; |
d91d68c1 | 28 | |
b6811f8d TC |
29 | my @perl = ( which_perl(), "-I../lib" ); |
30 | ||
d91d68c1 RS |
31 | # |
32 | # commands run 4 perl programs. Two of these programs write a | |
33 | # short message to STDOUT and exit. Two of these programs | |
34 | # read from STDIN. One reader never exits and must be killed. | |
35 | # the other reader reads one line, waits a few seconds and then | |
36 | # exits to test the waitpid function. | |
37 | # | |
a3815e44 | 38 | # Using 4+ arg open for the children that sleep so that we're |
b6811f8d TC |
39 | # killing the perl process instead of an intermediate shell, this |
40 | # allows harness to see the file handles closed sooner. I didn't | |
41 | # convert them all since I wanted 3-arg open to continue to be | |
42 | # exercised here. | |
43 | # | |
0970cf26 CB |
44 | # VMS does not have the list form of piped open, but it also would |
45 | # not create a separate process for an intermediate shell. | |
46 | if ($^O eq 'VMS') { | |
47 | $cmd1 = qq/$perl -e "\$|=1; print qq[first process\\n]; sleep 30;"/; | |
48 | $cmd2 = qq/$perl -e "\$|=1; print qq[second process\\n]; sleep 30;"/; | |
49 | } | |
50 | else { | |
51 | @cmd1 = ( @perl, "-e", "\$|=1; print qq[first process\\n]; sleep 30;" ); | |
52 | @cmd2 = ( @perl, "-e", "\$|=1; print qq[second process\\n]; sleep 30;" ); | |
53 | } | |
c8fc8fb0 JH |
54 | $cmd3 = qq/$perl -e "print <>;"/; # hangs waiting for end of STDIN |
55 | $cmd4 = qq/$perl -e "print scalar <>;"/; | |
d91d68c1 | 56 | |
b6811f8d | 57 | #warn "#@cmd1\n#@cmd2\n#$cmd3\n#$cmd4\n"; |
d91d68c1 RS |
58 | |
59 | # start the processes | |
0970cf26 CB |
60 | if ($^O eq 'VMS') { |
61 | ok( $pid1 = open(FH1, "$cmd1 |"), 'first process started'); | |
62 | ok( $pid2 = open(FH2, "$cmd2 |"), ' second' ); | |
63 | } | |
64 | else { | |
65 | ok( $pid1 = open(FH1, "-|", @cmd1), 'first process started'); | |
66 | ok( $pid2 = open(FH2, "-|", @cmd2), ' second' ); | |
67 | } | |
3fb41248 SP |
68 | { |
69 | no warnings 'once'; | |
70 | ok( $pid3 = open(FH3, "| $cmd3"), ' third' ); | |
71 | } | |
c8fc8fb0 | 72 | ok( $pid4 = open(FH4, "| $cmd4"), ' fourth' ); |
d91d68c1 RS |
73 | |
74 | print "# pids were $pid1, $pid2, $pid3, $pid4\n"; | |
75 | ||
4d61ec05 GS |
76 | my $killsig = 'HUP'; |
77 | $killsig = 1 unless $Config{sig_name} =~ /\bHUP\b/; | |
78 | ||
d91d68c1 RS |
79 | # get message from first process and kill it |
80 | chomp($from_pid1 = scalar(<FH1>)); | |
f0060996 MS |
81 | is( $from_pid1, 'first process', 'message from first process' ); |
82 | ||
4d61ec05 | 83 | $kill_cnt = kill $killsig, $pid1; |
f0060996 MS |
84 | is( $kill_cnt, 1, 'first process killed' ) || |
85 | print "# errno == $!\n"; | |
d91d68c1 RS |
86 | |
87 | # get message from second process and kill second process and reader process | |
88 | chomp($from_pid2 = scalar(<FH2>)); | |
f0060996 MS |
89 | is( $from_pid2, 'second process', 'message from second process' ); |
90 | ||
4d61ec05 | 91 | $kill_cnt = kill $killsig, $pid2, $pid3; |
f0060996 MS |
92 | is( $kill_cnt, 2, 'killing procs 2 & 3' ) || |
93 | print "# errno == $!\n"; | |
94 | ||
d91d68c1 RS |
95 | |
96 | # send one expected line of text to child process and then wait for it | |
d27127a1 SM |
97 | select(FH4); $| = 1; select(STDOUT); |
98 | ||
f0060996 MS |
99 | printf FH4 "ok %d - text sent to fourth process\n", curr_test(); |
100 | next_test(); | |
d91d68c1 RS |
101 | print "# waiting for process $pid4 to exit\n"; |
102 | $reap_pid = waitpid $pid4, 0; | |
f0060996 MS |
103 | is( $reap_pid, $pid4, 'fourth process reaped' ); |
104 |