1#!/usr/bin/perl
2
3BEGIN { chdir 't' if -d 't' };
4
5use strict;
6use warnings;
7use lib qw[../lib];
8use Test::More 'no_plan';
9use Data::Dumper;
10use File::Temp qw(tempfile);
11
12use_ok("IPC::Cmd", "run_forked");
13
14unless ( IPC::Cmd->can_use_run_forked ) {
15  ok(1, "run_forked not available on this platform");
16  exit;
17}
18else {
19  ok(1, "run_forked available on this platform");
20}
21
22my $true = IPC::Cmd::can_run('true');
23my $false = IPC::Cmd::can_run('false');
24my $echo = IPC::Cmd::can_run('echo');
25my $sleep = IPC::Cmd::can_run('sleep');
26my $cat = IPC::Cmd::can_run('cat');
27
28unless ( $true and $false and $echo and $sleep and $cat ) {
29  ok(1, 'Either "true" or "false" "echo" or "sleep" or "cat" is missing on this platform');
30  exit;
31}
32
33my $r;
34
35$r = run_forked($true);
36ok($r->{'exit_code'} eq '0', "$true returns 0");
37$r = run_forked($false);
38ok($r->{'exit_code'} ne '0', "$false returns not 0");
39
40$r = run_forked([$echo, "test"]);
41ok($r->{'stdout'} =~ /test/, "arrayref cmd: https://rt.cpan.org/Ticket/Display.html?id=70530");
42
43$r = run_forked("$sleep 5", {'timeout' => 2});
44ok($r->{'timeout'}, "[$sleep 5] runs longer than 2 seconds");
45
46SKIP: {
47  skip "Exhibits problems on Cygwin", 4 if $^O eq 'cygwin';
48  # https://rt.cpan.org/Ticket/Display.html?id=85912
49  sub runSub {
50       my $blah = "blahblah";
51       my $out= $_[0];
52       my $err= $_[1];
53
54       my $s = sub {
55          print "$blah\n";
56          print "$$: Hello $out\n";
57          warn "Boo!\n$err\n";
58       };
59
60       return run_forked($s);
61  }
62
63  my $retval= runSub("sailor", "eek!");
64  ok($retval->{"stdout"} =~ /blahblah/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stdout 1");
65  ok($retval->{"stdout"} =~ /Hello sailor/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stdout 2");
66  ok($retval->{"stderr"} =~ /Boo/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stderr 1");
67  ok($retval->{"stderr"} =~ /eek/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stderr 2");
68}
69
70$r = run_forked("$echo yes i know this is the way", {'discard_output' => 1});
71ok($r->{'stdout'} eq '', "discard_output stdout");
72ok($r->{'stderr'} eq '', "discard_output stderr");
73ok($r->{'merged'} eq '', "discard_output merged");
74ok($r->{'err_msg'} eq '', "discard_output err_msg");
75
76my ($fh, $filename) = tempfile();
77my $one_line = "in Montenegro with Katyusha\n";
78for (my $i = 0; $i < 10240; $i++) {
79  print $fh $one_line;
80}
81close($fh);
82
83
84SKIP: {
85  skip 'Skip these tests in PERL_CORE', 100 if $ENV{PERL_CORE};
86  skip 'These tests heisenfail on HPUX', 100 if $^O eq 'hpux';
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}
100unlink($filename);
101