Raphael Geissert wrote: > I've been working on Lintian::Command::Simple but got > stuck with the interface. I should probably push it somewhere and ask for > comments. > > I've also done some work on making t/runtests run multiple jobs in > parallel (using perl threads, actually). There's just one minor glitch I > should be able to fix within a few minutes. > The only downside is that the output is not clean, but unless I buffer it > (which won't make it really show in what order stuff is being done) > there's no other way around. >
I'm attaching both changes. Comments? suggestions? 0007 includes the first set of changes of Lintian::Command::Simple. In the .t file I was trying to decide the best way to handle multiple jobs while still being able to recognise which one is reaped. Cheers, -- Raphael Geissert - Debian Developer www.debian.org - get.debian.net
>From 93630fcb67991bb2c68dc45706b080043298f680 Mon Sep 17 00:00:00 2001 From: Raphael Geissert <atom...@gmail.com> Date: Sat, 20 Mar 2010 00:14:03 -0600 Subject: [PATCH] Run multiple tests from the testsuite in parallel Experimental implementation using Perl threads. Output is messy and the benefit is not _that_ great. Most of the tools (debhelper, dpkg-*, etc) turn the speed completely CPU-bound. --- t/runtests | 204 ++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 files changed, 156 insertions(+), 48 deletions(-) diff --git a/t/runtests b/t/runtests index 9f198e9..d29ae62 100755 --- a/t/runtests +++ b/t/runtests @@ -32,6 +32,8 @@ use warnings; use Data::Dumper; use Getopt::Long qw(GetOptions); use Text::Template; +use threads 'exit' => 'threads_only'; +use threads::shared; BEGIN { my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'}; @@ -68,13 +70,16 @@ our $STANDARDS_VERSION = '3.8.4'; sub usage { print unquote(<<"END"); -: Usage: $0 [-dkv] <testset-directory> <testing-directory> [<test>] -: $0 [-dkv] [-t <tag>] <testset-directory> <testing-directory> +: Usage: $0 [-dkv] [-j [<jobs>]] <testset-directory> <testing-directory> [<test>] +: $0 [-dkv] [-j [<jobs>]] [-t <tag>] <testset-directory> <testing-directory> : -: -d Display additional debugging information -: -k Do not stop after one failed test -: -t <tag> Run only tests for or against <tag> -: -v Be more verbose +: -d Display additional debugging information +: -j [<jobs>] Run up to <jobs> jobs in parallel. Defaults to two. +: If -j is passed without specifying <jobs>, the number +: of jobs started is <cpu cores>+1 if /proc/cpuinfo is readable. +: -k Do not stop after one failed test +: -t <tag> Run only tests for or against <tag> +: -v Be more verbose : : The optional 3rd parameter causes runtests to only run that particular : test. @@ -88,10 +93,12 @@ our $DEBUG = 0; our $VERBOSE = 0; our $RUNDIR; our $TESTSET; +our $JOBS = -1; my ($run_all_tests, $tag); Getopt::Long::Configure('bundling'); GetOptions('d|debug' => \$DEBUG, + 'j|jobs:i' => \$JOBS, 'k|keep-going' => \$run_all_tests, 't|tag=s' => \$tag, 'v|verbose' => \$VERBOSE) or usage; @@ -110,6 +117,31 @@ unless (-d $TESTSET) { fail("test set directory $TESTSET does not exist"); } +# Getopt::Long assigns 0 as default value if none was specified +if ($JOBS eq 0 && -r '/proc/cpuinfo') { + open(CPU, '<', '/proc/cpuinfo') + or fail("failed to open /proc/cpuinfo: $!"); + while (<CPU>) { + next unless m/^cpu cores\s*:\s*(\d+)/; + $JOBS += $1; + } + close(CPU); + + print "Apparent number of cores: $JOBS\n" if $DEBUG; + + # Running up to twice the number of cores usually gets the most out + # of the CPUs and disks but it might be too aggresive to be the + # default for -j. Only use <cores>+1 then. + $JOBS++; +} + +# No decent number of jobs? set a default +# Above $JOBS should be set to -1 so that this condition is always met, +# therefore avoiding duplication. +if ($JOBS le 0) { + $JOBS = 2; +} + # --- Display output immediately $| = 1; @@ -124,9 +156,16 @@ my $status = 0; # If we don't run any tests, we'll want to warn that we couldn't find # anything. -my $tests_run = 0; +my $tests_run :shared = 0; + +# $JOBS is the limit, $jobs is how many there are left to be started +my $jobs = $JOBS; + +# a stack with the created threads +my @threads; + +my @tests :shared; -my @tests; my $prev; # --- Run all test scripts @@ -145,7 +184,7 @@ if ($singletest) { if (@tests) { print "Test scripts:\n"; - if (system('prove', '-r', '-I', "$LINTIAN_ROOT/lib", @tests) != 0) { + if (system('prove', '-j', $JOBS, '-r', '-I', "$LINTIAN_ROOT/lib", @tests) != 0) { exit 1 unless $run_all_tests; $status = 1; } @@ -178,14 +217,29 @@ if ($singletest) { } print "Found the following changes tests: @tests\n" if $DEBUG; print "Changes tests:\n" if @tests; -for (@tests) { - my $okay = test_changes($_); - unless ($okay) { - exit 1 unless $run_all_tests; - $status = 1; - } - $tests_run++; + +while ($jobs--) { + print "Starting one thread, $jobs left\n" if $DEBUG; + my $thread = async { + while (scalar @tests) { + { + lock(@tests); + $_ = shift @tests; + } + my $okay = test_changes($_); + unless ($okay) { + exit 1 unless $run_all_tests; + $status = 1; + } + lock($tests_run); + $tests_run++; + } + }; + push @threads, $thread; } +$jobs++; +while ($_ = shift @threads) { $_->join(); $jobs++; print "Joined threads: $jobs/$JOBS\n" if $DEBUG; } +die("Some threads are still alive") if (threads->list(threads::all) != 0); # --- Run all debs tests @@ -217,14 +271,29 @@ if ($prev and @tests) { } print "Found the following debs tests: @tests\n" if $DEBUG; print "Raw Debian package tests:\n" if @tests; -for (@tests) { - my $okay = test_deb($_); - unless ($okay) { - exit 1 unless $run_all_tests; - $status = 1; - } - $tests_run++; + +while ($jobs--) { + print "Starting one thread, $jobs left\n" if $DEBUG; + my $thread = async { + while (scalar @tests) { + { + lock(@tests); + $_ = shift @tests; + } + my $okay = test_deb($_); + unless ($okay) { + exit 1 unless $run_all_tests; + $status = 1; + } + lock($tests_run); + $tests_run++; + } + }; + push @threads, $thread; } +$jobs++; +while ($_ = shift @threads) { $_->join(); $jobs++; print "Joined threads: $jobs/$JOBS\n" if $DEBUG; } +die("Some threads are still alive") if (threads->list(threads::all) != 0); # --- Run all source tests @@ -256,51 +325,89 @@ if ($prev and @tests) { } print "Found the following source tests: @tests\n" if $DEBUG; print "Raw Debian source package tests:\n" if @tests; -for (@tests) { - my $okay = test_source($_); - unless ($okay) { - exit 1 unless $run_all_tests; - $status = 1; - } - $tests_run++; + +while ($jobs--) { + print "Starting one thread, $jobs left\n" if $DEBUG; + my $thread = async { + while (scalar @tests) { + { + lock(@tests); + $_ = shift @tests; + } + my $okay = test_source($_); + unless ($okay) { + exit 1 unless $run_all_tests; + $status = 1; + } + lock($tests_run); + $tests_run++; + } + }; + push @threads, $thread; } +$jobs++; +while ($_ = shift @threads) { $_->join(); $jobs++; print "Joined threads: $jobs/$JOBS\n" if $DEBUG; } +die("Some threads are still alive") if (threads->list(threads::all) != 0); # --- Run all package tests $prev = $prev || scalar(@tests); @tests = (); +my @tests_data; if ($singletest) { my $desc = "$TESTSET/tests/$singletest/desc"; if (-f $desc) { - @tests = read_dpkg_control($desc); + @tests_data = read_dpkg_control($desc); } } elsif ($tag) { - @tests = find_tests_for_tag($tag); + @tests_data = find_tests_for_tag($tag); } else { unless (-d $TESTSET) { fail("cannot find $TESTSET: $!"); } - @tests = map { read_dpkg_control($_) } <$TESTSET/tests/*/desc>; + @tests_data = map { read_dpkg_control($_) } <$TESTSET/tests/*/desc>; } -...@tests = sort { +...@tests_data = sort { $a->{sequence} <=> $b->{sequence} || $a->{testname} cmp $b->{testname} - } @tests; -print "\n" if ($prev and @tests); + } @tests_data; + +my $tests = shared_clone(\...@tests_data); + +# free unused memory: +...@tests_data = (); undef @tests_data; + +print "\n" if ($prev and @$tests); if ($DEBUG) { print "Found the following tests: "; - print join(' ', map { $_->{testname} } @tests); + print join(' ', map { $_->{testname} } @$tests); print "\n"; } -print "Package tests:\n" if @tests; -for my $test (@tests) { - my $okay = test_package($test); - unless ($okay) { - exit 1 unless $run_all_tests; - $status = 1; - } - $tests_run++; +print "Package tests:\n" if @$tests; + +while ($jobs--) { + print "Starting one thread, $jobs left\n" if $DEBUG; + my $thread = async { + while (scalar @$tests) { + my $test; + { + lock($tests); + $test = shift @$tests; + } + my $okay = test_package($test); + unless ($okay) { + exit 1 unless $run_all_tests; + $status = 1; + } + lock($tests_run); + $tests_run++; + } + }; + push @threads, $thread; } +$jobs++; +while ($_ = shift @threads) { $_->join(); $jobs++; print "Joined threads: $jobs/$JOBS\n" if $DEBUG; } +die("Some threads are still alive") if (threads->list(threads::all) != 0); # --- Check whether we ran any tests @@ -669,12 +776,13 @@ sub unquote { sub runsystem { print "runsystem(@_)\n" if $DEBUG; - system(@_) == 0 - or fail("failed: @_\n"); + + runsystem_ok(@_) or fail("failed: @_\n"); } sub runsystem_ok { - print "runsystem_ok(@_)\n" if $DEBUG; + print "runsystem_ok(@_) ok $$ (tid: ".threads->tid().")\n" if $DEBUG; + my $errcode = system(@_); $errcode == 0 or $errcode == (1 << 8) or fail("failed: @_\n"); -- 1.7.0
>From c13bdec5d6a080902e374085d411afda0549715e Mon Sep 17 00:00:00 2001 From: Raphael Geissert <atom...@gmail.com> Date: Wed, 3 Mar 2010 23:55:09 -0600 Subject: [PATCH 7/7] Introduce Lintian::Command::Simple to run commands without pipes Running multiple asynchronous processes with Lintian::Command leads to an extra overhead. This new module should ease multiple tasks that don't require pipes to/from Perl code or other special features provided by Lintian::Command. --- lib/Lintian/Command/Simple.pm | 227 ++++++++++++++++++++ t/scripts/Lintian/Command/Simple/01-basic.t | 10 + t/scripts/Lintian/Command/Simple/02-OO-basic.t | 14 ++ t/scripts/Lintian/Command/Simple/03-background.t | 31 +++ .../Lintian/Command/Simple/04-OO-background.t | 26 +++ t/scripts/Lintian/Command/Simple/05-OO-errors.t | 67 ++++++ .../Lintian/Command/Simple/06-return-status.t | 19 ++ .../Lintian/Command/Simple/07-OO-other-methods.t | 22 ++ t/scripts/pod-coverage.t | 1 + 9 files changed, 417 insertions(+), 0 deletions(-) create mode 100644 lib/Lintian/Command/Simple.pm create mode 100644 t/scripts/Lintian/Command/Simple/01-basic.t create mode 100644 t/scripts/Lintian/Command/Simple/02-OO-basic.t create mode 100644 t/scripts/Lintian/Command/Simple/03-background.t create mode 100644 t/scripts/Lintian/Command/Simple/04-OO-background.t create mode 100644 t/scripts/Lintian/Command/Simple/05-OO-errors.t create mode 100644 t/scripts/Lintian/Command/Simple/06-return-status.t create mode 100644 t/scripts/Lintian/Command/Simple/07-OO-other-methods.t diff --git a/lib/Lintian/Command/Simple.pm b/lib/Lintian/Command/Simple.pm new file mode 100644 index 0000000..7d9c7b9 --- /dev/null +++ b/lib/Lintian/Command/Simple.pm @@ -0,0 +1,227 @@ +# Copyright (C) 2010 Raphael Geissert <atom...@gmail.com> +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the Free +# Software Foundation; either version 2 of the License, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for +# more details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see <http://www.gnu.org/licenses/>. + +package Lintian::Command::Simple; + +use strict; +use warnings; + +=head1 NAME + +Lintian::Command::Simple - Run commands without pipes + +=head1 SYNOPSIS + + use Lintian::Command::Simple; + + Lintian::Command::Simple::exec("echo", "hello world"); + + # Start a command in the background: + Lintian::Command::Simple::fork("sleep", 10); + print (Lintian::Command::Simple::wait())? "success" : "failure"; + + # Using the OO interface + + my $cmd = Lintian::Command::Simple->new(); + + $cmd->exec("echo", "hello world"); + + $cmd->fork("sleep", 10); + print ($cmd->wait())? "success" : "failure"; + + +=head1 DESCRIPTION + +Lintian::Command::Simple allows running commands with the capability of +running them "in the background" (asynchronously.) + +Pipes are not handled at all, except for those handled internally by +the shell. See 'perldoc -f exec's note about shell metacharacters. +If you want to pipe to/from Perl, look at Lintian::Command instead. + +A procedural and an Object-Oriented (from now on OO) interfaces are +provided. + +It is possible to reuse an object to run multiple commands, but only +after reaping the previous command. + +=item new() + +Creates a new Lintian::Command::Simple object and returns a reference +to it. + +=cut + +sub new { + my ($class, $pkg) = @_; + my $self = {}; + bless($self, $class); + return $self; +} + +=item exec(command, argument [, ...]) + +Executes the given C<command> with the given arguments and returns the +status code as one would see it from a shell script. + +Being fair, the only advantage of this function (or method) over the +CORE::system() function is the way the return status is reported. + +=cut + +sub exec { + my $self; + + if (ref $_[0]) { + $self = shift; + return -1 + if defined($self->{'pid'}); + } + + system(@_); + + return $? >> 8; +} + +=item fork(command, argument [, ...]) + +Executes the given C<command> with the given arguments asynchronously +and returns the process id of the child process. + +A return value of -1 indicates an error. This can either be a problem +when calling CORE::fork() or when trying to run another command before +calling wait() to reap the previous command. + +=cut + +sub fork { + my $self; + + if (ref $_[0]) { + $self = shift; + return -1 + if (defined($self->{'pid'})); + } + + my $pid = fork(); + + if (not defined($pid)) { + # failed + return -1; + } elsif ($pid > 0) { + # parent + + $self->{'pid'} = $pid + if (defined($self)); + + return $pid; + } else { + # child + close(STDIN); + open(STDIN, '<', '/dev/null'); + + CORE::exec @_ or die("Failed to exec '$_[0]': $!\n"); + } +} + +=item wait([pid]) + +When called as a function: +If C<pid> is specified, it waits until the given process (which must be +a child of the current process) returns. If C<pid> is not specified, it +waits for any child process to finish and returns. + +When called as a method: +It takes no argument. It waits for the previously fork()ed process to +return. + +The return value is either -1, probably indicating an error, or the +return status of the process as it would be seen from a shell script. +See 'perldoc -f wait' for more details about the possible meanings of +-1. + +=cut + +sub wait { + my ($self, $pid); + + if (ref $_[0]) { + $self = shift; + $pid = $self->{'pid'}; + } else { + $pid = shift; + } + + if (defined($pid)) { + $self->{'pid'} = undef + if defined($self); + return (waitpid($pid, 0) == -1)? -1 : ($? >> 8); + } elsif (not defined($self)) { + return (wait() == -1)? -1 : ($? >> 8); + } else { + return -1; + } +} + +=item pid() + +Only available under the OO interface, it returns the pid of a +fork()ed process. + +After calling wait(), this method always returns undef. + +=cut + +sub pid { + my $self = shift; + + return $self->{'pid'}; +} + +1; + +__END__ + +=back +=head1 TODO + +Provide the necessary methods to modify the environment variables of +the to-be-executed commands. This would let us drop C<system_env> (from +lib/Util.pm) and make C<exec> more useful. + +=head1 NOTES + +Unless specified by prefixing the package name, every reference to a +function/method in this documentation refers to the functions/methods +provided by this package itself. + +=head1 CAVEATS + +Combining asynchronous jobs from Lintian::Command and calls to wait() +can lead to unexpected results. + +Calling wait() without a pid via the procedural interface can lead to +processes started via the OO interface to be reaped. In this case, the +object that started the reaped process won't be able to determine the +return status, which can affect the rest of the application. + +As a general advise, the procedural and OO interfaces should not be +combined when using fork(). + +=head1 AUTHOR + +Originally written by Raphael Geissert <atom...@gmail.com> for Lintian. + +=cut diff --git a/t/scripts/Lintian/Command/Simple/01-basic.t b/t/scripts/Lintian/Command/Simple/01-basic.t new file mode 100644 index 0000000..06ba8c1 --- /dev/null +++ b/t/scripts/Lintian/Command/Simple/01-basic.t @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 3; + +BEGIN { use_ok('Lintian::Command::Simple'); } + +is(Lintian::Command::Simple::exec("true"), 0, 'Basic exec (true)'); +is(Lintian::Command::Simple::exec("false"), 1, 'Basic exec (false)'); diff --git a/t/scripts/Lintian/Command/Simple/02-OO-basic.t b/t/scripts/Lintian/Command/Simple/02-OO-basic.t new file mode 100644 index 0000000..b814a53 --- /dev/null +++ b/t/scripts/Lintian/Command/Simple/02-OO-basic.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 3; + +use Lintian::Command::Simple; + +my $cmd; + +ok(eval { $cmd = Lintian::Command::Simple->new(); }, 'Create'); + +is($cmd->exec("true"), 0, 'Basic exec (true)'); +is($cmd->exec("false"), 1, 'Basic exec (false)'); diff --git a/t/scripts/Lintian/Command/Simple/03-background.t b/t/scripts/Lintian/Command/Simple/03-background.t new file mode 100644 index 0000000..a4eea79 --- /dev/null +++ b/t/scripts/Lintian/Command/Simple/03-background.t @@ -0,0 +1,31 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 9; + +use Lintian::Command::Simple; + +my $pid; + +$pid = Lintian::Command::Simple::fork("true"); +cmp_ok($pid, '>', 0, 'Basic fork (true)'); + +is(waitpid($pid, 0), $pid, "Waiting for pid"); +is($?, 0, "Return status is 0"); + +# Again but using helper function + +$pid = Lintian::Command::Simple::fork("true"); +cmp_ok($pid, '>', 0, 'Basic fork (true), take two'); + +is(Lintian::Command::Simple::wait($pid), 0, "Waiting and checking return status"); +is(waitpid($pid, 0), -1, "Process was really reaped"); + +# One more time, but without passing a pid to wait() + +$pid = Lintian::Command::Simple::fork("true"); +cmp_ok($pid, '>', 0, 'Basic fork (true), take three'); + +is(Lintian::Command::Simple::wait(), 0, "Waiting and checking \$? of any child"); +is(wait(), -1, "Process was really reaped"); diff --git a/t/scripts/Lintian/Command/Simple/04-OO-background.t b/t/scripts/Lintian/Command/Simple/04-OO-background.t new file mode 100644 index 0000000..48eb766 --- /dev/null +++ b/t/scripts/Lintian/Command/Simple/04-OO-background.t @@ -0,0 +1,26 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 6; + +use Lintian::Command::Simple; + +my ($cmd, $pid); + +$cmd = Lintian::Command::Simple->new(); + +$pid = $cmd->fork("true"); + +cmp_ok($pid, '>', 0, 'Basic fork (true)'); +is(waitpid($pid, 0), $pid, "Waiting for pid"); +is($?, 0, "Return status is 0"); + +# Again but using helper function + +$cmd = Lintian::Command::Simple->new(); +$pid = $cmd->fork("true"); + +cmp_ok($pid, '>', 0, 'Basic fork (true), take two'); +is($cmd->wait(), 0, "Waiting and checking return status"); +is(waitpid($pid, 0), -1, "Process was really reaped"); diff --git a/t/scripts/Lintian/Command/Simple/05-OO-errors.t b/t/scripts/Lintian/Command/Simple/05-OO-errors.t new file mode 100644 index 0000000..d70cc8b --- /dev/null +++ b/t/scripts/Lintian/Command/Simple/05-OO-errors.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 17; + +use Lintian::Command::Simple; + +my ($cmd, $pid); + +# Run a command via the procedural interface and make sure calling the +# OO's interface wait() doesn't reap it (because the OO interface +# should only deal with any command started with it) + +$pid = Lintian::Command::Simple::fork("true"); + +$cmd = Lintian::Command::Simple->new(); + +is($cmd->wait(), -1, "No job via OO interface, wait() returns -1"); + +is(Lintian::Command::Simple::wait($pid), 0, "Checking \$? of the started child"); + +# Run two commands in a row on the same object, without wait()ing + +$cmd = Lintian::Command::Simple->new(); + +cmp_ok($cmd->fork("true"), '>', 0, 'Running one job is ok'); +is($cmd->fork("false"), -1, 'Running a second job is not'); + +is($cmd->wait(), 0, "We wait() for the 'true' job"); +is(Lintian::Command::Simple::wait(), -1, "No other job is running"); + +# Run two commands in a row on the same object, wait()ing + +$cmd = Lintian::Command::Simple->new(); + +cmp_ok($cmd->fork("true"), '>', 0, 'Running one job is ok'); +is($cmd->wait(), 0, "We wait() for the 'true' job"); + +cmp_ok($cmd->fork("false"), '>', 0, 'Running a second job is ok after wait()ing'); +is($cmd->wait(), 1, "We wait() for the 'true' job"); + +# Just like the above cases, but combining a fork and an exec + +$cmd = Lintian::Command::Simple->new(); + +cmp_ok($cmd->fork("true"), '>', 0, 'Running one job is ok'); +is($cmd->exec("false"), -1, 'Running exec() before wait()ing is not'); + +is($cmd->wait(), 0, "We wait() for the 'true' job"); + +# It can happen that a pid-less call to wait() reaps a job started by +# an instance of the object. Make sure this case is handled nicely. + +$cmd = Lintian::Command::Simple->new(); + +$cmd->fork("true"); + +is(Lintian::Command::Simple::wait(), 0, 'Another wait() call reaps an OO job'); + +is($cmd->wait(), -1, "We only know the job is gone, no return status"); + +# But it was reaped anyway, so make sure it is possible to start +# another job via the same object. + +cmp_ok($cmd->fork("true"), '>', 0, 'Running a second job is ok after foreign wait()'); +is($cmd->wait(), 0, "We wait() for the 'true' job"); diff --git a/t/scripts/Lintian/Command/Simple/06-return-status.t b/t/scripts/Lintian/Command/Simple/06-return-status.t new file mode 100644 index 0000000..981ecfb --- /dev/null +++ b/t/scripts/Lintian/Command/Simple/06-return-status.t @@ -0,0 +1,19 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 2; + +use Lintian::Command::Simple; + +my $pid; + +$pid = Lintian::Command::Simple::fork("false"); + +is(Lintian::Command::Simple::wait($pid), 1, "Waiting with pid and checking return status"); + +# One more time, but without passing a pid to wait() + +$pid = Lintian::Command::Simple::fork("false"); + +is(Lintian::Command::Simple::wait(), 1, "Waiting without pid and checking return status"); diff --git a/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t b/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t new file mode 100644 index 0000000..74e9acb --- /dev/null +++ b/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t @@ -0,0 +1,22 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 2; + +use Lintian::Command::Simple; + +my ($cmd, $pid); + +$cmd = Lintian::Command::Simple->new(); + +$pid = $cmd->fork("true"); +is($cmd->pid(), $pid, 'pid() returns PID after fork()'); + +$cmd->wait(); + +# Using an object to run exec() should not preserve the old pid. +# However, this test should never fail if we wait()ed for the old process + +$cmd->exec("true"); +isnt($cmd->pid(), $pid, 'pid() is no longer the old PID after exec()'); diff --git a/t/scripts/pod-coverage.t b/t/scripts/pod-coverage.t index db371e9..4b472f0 100755 --- a/t/scripts/pod-coverage.t +++ b/t/scripts/pod-coverage.t @@ -16,6 +16,7 @@ our %MODULES = 'Lintian::Check' => [], 'Lintian::Collect' => [], 'Lintian::Command' => [], + 'Lintian::Command::Simple' => [], 'Lintian::Data' => [], 'Lintian::DepMap' => [], 'Lintian::Relation' => [ qr/^parse_element$/, -- 1.7.0
#!/usr/bin/perl use strict; use warnings; use Test::More; use Lintian::Command::Simple; my ($cmd, $pid); my $c = 4; my %jobs; while ($c--) { $cmd = Lintian::Command::Simple->new(); $cmd->fork("sleep", 3); $jobs{$c} = $cmd; } while ((my $done = Lintian::Command::Simple::wait(\%jobs)) > 0) { $c++; } is($c, 4, "4 jobs were started, 4 reaped"); done_testing();