This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix IPC-Cmd tests for Solaris (and potentially other SVR* variants)
[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
26 unless ( $true and $false and $echo and $sleep ) {
27   ok(1, 'Either "true" or "false" "echo" or "sleep" is missing on this platform');
28   exit;
29 }
30
31 my $r;
32
33 $r = run_forked($true);
34 ok($r->{'exit_code'} eq '0', "$true returns 0");
35 $r = run_forked($false);
36 ok($r->{'exit_code'} ne '0', "$false returns 1");
37
38 $r = run_forked([$echo, "test"]);
39 ok($r->{'stdout'} =~ /test/, "arrayref cmd: https://rt.cpan.org/Ticket/Display.html?id=70530");
40
41 $r = run_forked("$sleep 5", {'timeout' => 2});
42 ok($r->{'timeout'}, "[sleep 5] runs longer than 2 seconds");
43
44
45 # https://rt.cpan.org/Ticket/Display.html?id=85912
46 sub runSub {
47        my $blah = "blahblah";
48        my $out= $_[0];
49        my $err= $_[1];
50
51        my $s = sub {
52           print "$blah\n";
53           print "$$: Hello $out\n";
54           warn "Boo!\n$err\n";
55        };
56
57        return run_forked($s);
58 }
59
60 my $retval= runSub("sailor", "eek!");
61 ok($retval->{"stdout"} =~ /blahblah/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stdout 1");
62 ok($retval->{"stdout"} =~ /Hello sailor/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stdout 2");
63 ok($retval->{"stderr"} =~ /Boo/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stderr 1");
64 ok($retval->{"stderr"} =~ /eek/, "https://rt.cpan.org/Ticket/Display.html?id=85912 stderr 2");