The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl

# Copyright 2005-2008, Sam Vilain.  All rights reserved.  This program
# is free software; you can use it and/or distribute it under the same
# terms as Perl itself; either the latest stable release of Perl when
# the module was written, or any subsequent stable release.

use warnings;
use strict;
use t::Util;

use Scriptalicious;

use Test::More tests => 17;

my ($rc, @out) = capture_err($^X, "-Mlib=lib", "t/fork.pl", "-v");

is($rc, 0, "Command completed successfully");

my $out = join "", @out;

like($out, qr/\(parent\)/, "Parent managed to use the timer");
like($out, qr/\(child\)/, "Child managed to use the timer");

# test that file descriptors can be fed in lots of different ways

slop $testfile, "Hello, world!";
my $output = capture( -in => $testfile,
		      $^X, "-Mlib=lib", "t/loopback.pl");
like($output, qr/:.*Hello, world!/, "run -in => 'FILENAME'");

$output = capture( -in => sub { print "Hi there\n" },
		   $^X, "-Mlib=lib", "t/loopback.pl");
like($output, qr/:.*Hi there/, "run -in => SUB");

open TEST, "<$testfile" or barf "damn! $!";
$output = capture( -in => \*TEST,
		   $^X, "-Mlib=lib", "t/loopback.pl");
like($output, qr/:.*Hello, world!/, "run -in => GLOB");
close TEST;

# output...
$output = capture( -out => $testfile,
		   -in  => sub { print "Loop this!\n" },
		   $^X, "-Mlib=lib", "t/loopback.pl");
is($output, "", "run out => 'FILENAME' (no output from capture)");
$output = slurp $testfile;
like($output, qr/:.*Loop this!/, "run -out => 'FILENAME'");

$output = capture( -out => sub { my $foo = <STDIN>;
				 slop $testfile, $foo;
			     },
		   -in  => sub { print "slopslopslop\n" },
		   $^X, "-Mlib=lib", "t/loopback.pl");
is($output, "", "run out => CODE (no output from capture)");
$output = slurp $testfile;
like($output, qr/:.*slopslopslop/, "run -out => CODE");

open TEST, ">$testfile" or barf $!;
$output = capture( -out => \*TEST,
		   -in  => sub { print "suckonthis!\n" },
		   $^X, "-Mlib=lib", "t/loopback.pl");
is($output, "", "run out => GLOB (no output from capture)");
close TEST;
$output = slurp $testfile;
like($output, qr/:.*suckonthis!/, "run -out => GLOB");

# explicit file descriptors...
slop $testfile, "Burp";
$output = capture( -in4  => $testfile,
		   $^X, "-Mlib=lib", "t/loopback.pl", qw(-i 4));
like($output, qr/Burp/, "-in4 => 'FILENAME'");

slop $testfile, "Burp";
$output = capture( -in => sub { print "It should be so easy!\n" },
		   -out4  => $testfile,
		   $^X, "-Mlib=lib", "t/loopback.pl", qw(-o 4));
is($output, "", "-out4 => 'FILENAME' (no output from capture)");
$output = slurp $testfile;
like($output, qr/:.*easy!/, "run -out4 => 'FILENAME'");

# last out!
$output = capture( -in5 => sub { print "slurpamunchalot\n" },
		   -out4  => sub { my $foo = <STDIN>;
				   slop $testfile, $foo },
		   $^X, "-Mlib=lib", "t/loopback.pl", qw(-o 4 -i 5));
is($output, "", "run -out4 => CODE, -in4 => CODE (no output from capture)");
$output = slurp $testfile;
like($output, qr/:.*slurpamunchalot/, "run -out4 => CODE, -in4 => CODE");