This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update IPC-Cmd to CPAN version 0.90
[perl5.git] / cpan / IPC-Cmd / t / 03_run-forked.t
1 #!/usr/bin/perl
2
3 BEGIN { chdir 't' if -d 't' };
4
5 use strict;
6 use warnings;
7 use lib qw[../lib];
8 use Test::More 'no_plan';
9 use Data::Dumper;
10
11 use_ok("IPC::Cmd", "run_forked");
12
13 unless ( IPC::Cmd->can_use_run_forked ) {
14   ok(1, "run_forked not available on this platform");
15   exit;
16 }
17 else {
18   ok(1, "run_forked available on this platform");
19 }
20
21 my $true = IPC::Cmd::can_run('true');
22 my $false = IPC::Cmd::can_run('false');
23 my $echo = IPC::Cmd::can_run('echo');
24 my $sleep = IPC::Cmd::can_run('sleep');
25 my $cat = IPC::Cmd::can_run('cat');
26
27 unless ( $true and $false and $echo and $sleep and $cat ) {
28   ok(1, 'Either "true" or "false" "echo" or "sleep" or "cat" is missing on this platform');
29   exit;
30 }
31
32 my $r;
33
34 $r = run_forked($true);
35 ok($r->{'exit_code'} eq '0', "$true returns 0");
36 $r = run_forked($false);
37 ok($r->{'exit_code'} ne '0', "$false returns not 0");
38
39 $r = run_forked([$echo, "test"]);
40 ok($r->{'stdout'} =~ /test/, "arrayref cmd: https://rt.cpan.org/Ticket/Display.html?id=70530");
41
42 $r = run_forked("$sleep 5", {'timeout' => 2});
43 ok($r->{'timeout'}, "[$sleep 5] runs longer than 2 seconds");
44
45 SKIP: {
46   skip "Exhibits problems on Cygwin", 4 if $^O eq 'cygwin';
47   # https://rt.cpan.org/Ticket/Display.html?id=85912
48   sub runSub {
49        my $blah = "blahblah";
50        my $out= $_[0];
51        my $err= $_[1];
52
53        my $s = sub {
54           print "$blah\n";
55           print "$$: Hello $out\n";
56           warn "Boo!\n$err\n";
57        };
58
59        return run_forked($s);
60   }
61
62   my $retval= runSub("sailor", "eek!");
63   ok($retval->{"stdout"} =~ /blahblah/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stdout 1");
64   ok($retval->{"stdout"} =~ /Hello sailor/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stdout 2");
65   ok($retval->{"stderr"} =~ /Boo/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stderr 1");
66   ok($retval->{"stderr"} =~ /eek/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stderr 2");
67 }
68
69 $r = run_forked("$echo yes i know this is the way", {'discard_output' => 1});
70 ok($r->{'stdout'} eq '', "discard_output stdout");
71 ok($r->{'stderr'} eq '', "discard_output stderr");
72 ok($r->{'merged'} eq '', "discard_output merged");
73 ok($r->{'err_msg'} eq '', "discard_output err_msg");
74
75 my $filename = "/tmp/03_run_forked.t.$$";
76 my $one_line = "in Montenegro with Katyusha\n";
77 my $fh;
78 open($fh, ">$filename");
79 for (my $i = 0; $i < 10240; $i++) {
80   print $fh $one_line;
81 }
82 close($fh);
83
84
85 SKIP: {
86   skip 'Skip these tests in PERL_CORE', 100 if $ENV{PERL_CORE};
87   for (my $i = 0; $i < 100; $i++) {
88     my $f_ipc_cmd = IPC::Cmd::run_forked("$cat $filename");
89     my $f_backticks = `$cat $filename`;
90     if ($f_ipc_cmd->{'stdout'} ne $f_backticks) {
91       fail ("reading $filename: run_forked output length [" . length($f_ipc_cmd->{'stdout'}) . "], backticks output length [" . length ($f_backticks) . "]");
92       #print Data::Dumper::Dumper($f_ipc_cmd);
93       die;
94     }
95     else {
96       pass ("$i: reading $filename");
97     }
98   }
99 }
100 unlink($filename);