Re: Another lintian release for squeeze?
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 <atomo64@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 <atomo64@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 <atomo64@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 <atomo64@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();
Reply to: