1#!/usr/bin/perl 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program. If not, see <https://www.gnu.org/licenses/>. 15 16use strict; 17use warnings; 18 19use Test::More tests => 8; 20 21use File::Temp qw(tempfile); 22 23use_ok('Dpkg::IPC'); 24 25$/ = undef; 26 27my ($tmp1_fh, $tmp1_name) = tempfile(UNLINK => 1); 28my ($tmp2_fh, $tmp2_name) = tempfile(UNLINK => 1); 29my $tmp_fh; 30 31my $string1 = "foo\nbar\n"; 32my $string2; 33 34open $tmp_fh, '>', $tmp1_name 35 or die "cannot open $tmp1_name: $!"; 36print { $tmp_fh } $string1; 37close $tmp_fh; 38 39my $pid = spawn(exec => 'cat', 40 from_string => \$string1, 41 to_string => \$string2); 42 43ok($pid, 'execute cat program, I/O to variables'); 44 45is($string2, $string1, '{from,to}_string'); 46 47$pid = spawn(exec => 'cat', 48 from_handle => $tmp1_fh, 49 to_handle => $tmp2_fh); 50 51ok($pid, 'execute cat program, I/O to filehandles'); 52 53wait_child($pid); 54 55open $tmp_fh, '<', $tmp2_name 56 or die "cannot open $tmp2_name: $!"; 57$string2 = <$tmp_fh>; 58close $tmp_fh; 59 60is($string2, $string1, '{from,to}_handle'); 61 62$pid = spawn(exec => 'cat', 63 from_file => $tmp1_name, 64 to_file => $tmp2_name, 65 wait_child => 1); 66 67ok($pid, 'execute cat program, I/O to filenames and wait'); 68 69open $tmp_fh, '<', $tmp2_name 70 or die "cannot open $tmp2_name: $!"; 71$string2 = <$tmp_fh>; 72close $tmp_fh; 73 74is($string2, $string1, '{from,to}_file'); 75 76eval { 77 $pid = spawn(exec => ['sleep', '10'], 78 wait_child => 1, 79 timeout => 1); 80}; 81ok($@, 'fails on timeout'); 82