#
################################################################################
#
-# $Revision: 12 $
+# $Revision: 13 $
# $Author: mhx $
-# $Date: 2006/05/22 20:26:02 +0200 $
+# $Date: 2006/07/08 16:58:56 +0200 $
#
################################################################################
#
use List::Util qw(max);
use Config;
-my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_07 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.09 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
$| = 1;
-my $verbose = 0;
-my $MAKE = $Config{make} || 'make';
my %OPT = (
verbose => 0,
make => $Config{make} || 'make',
min => '5.000',
+ color => 1,
);
-GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@)) or pod2usage(2);
+GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@ color!)) or pod2usage(2);
$OPT{mmargs} = [''] unless exists $OPT{mmargs};
$OPT{min} = parse_version($OPT{min}) - 1e-10;
+sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }
+
my @GoodPerls = map { $_->[0] }
sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
grep { $_->[1] >= $OPT{min} }
my $mmalen = max(map length, @{$OPT{mmargs}});
$maxlen += $mmalen+3 if $mmalen > 0;
-# run each through the test harness
-my(@good, @bad, $total);
+my $rep = Soak::Reporter->new( verbose => $OPT{verbose}
+ , color => $OPT{color}
+ , width => $maxlen
+ );
+
+$SIG{__WARN__} = sub { $rep->warn(@_) };
+$SIG{__DIE__} = sub { $rep->die(@_) };
# prime the pump, so the first "make realclean" will work.
-runit("$^X Makefile.PL") && runit("$MAKE realclean")
- or die "Cannot run $^X Makefile.PL && $MAKE realclean\n";
+runit("$^X Makefile.PL") && runit("$OPT{make} realclean")
+ or $rep->die("Cannot run $^X Makefile.PL && $OPT{make} realclean\n");
-print "Testing ", scalar @GoodPerls, " versions/configurations...\n\n";
+$rep->status(sprintf("Testing %d version%s / %d configuration%s (%d combination%s)...\n",
+ cs(@GoodPerls), cs(@{$OPT{mmargs}}), cs(@GoodPerls*@{$OPT{mmargs}})));
for my $perl (@GoodPerls) {
for my $mm (@{$OPT{mmargs}}) {
- my $config = $mm =~ /\S+/ ? " ($mm)" : '';
- my $prefix = $verbose ? "$perl$config -- " : '';
- print "Testing $perl$config " . ('.' x ($maxlen - length($perl.$config)));
+ $rep->set(perl => $perl, config => $mm);
+
+ $rep->test;
+
+ my @warn_mfpl;
+ my @warn_make;
+ my @warn_test;
+
+ my $ok = runit("$perl Makefile.PL $mm", \@warn_mfpl) &&
+ runit("$OPT{make}", \@warn_make) &&
+ runit("$OPT{make} test", \@warn_test);
- my $ok = runit("$perl Makefile.PL $mm") &&
- # runit("$perl Makefile.PL --with-apicheck") &&
- runit("$MAKE test");
+ $rep->warnings(['Makefile.PL' => \@warn_mfpl],
+ ['make' => \@warn_make],
+ ['make test' => \@warn_test]);
- $total++;
if ($ok) {
- push @good, [$perl, $mm];
- print "${prefix}ok\n";
+ $rep->passed;
}
else {
- push @bad, [$perl, $mm];
- print "${prefix}not ok\n";
+ $rep->failed;
}
- runit("$MAKE realclean");
+ runit("$OPT{make} realclean");
}
}
-if (@bad) {
- print "\nFailed with:\n";
- for my $fail (@bad) {
- my($perl, $mm) = @$fail;
- my $config = $mm =~ /\S+/ ? " ($mm)" : '';
- print " $perl$config\n";
- }
-}
-
-print "\nPassed with ", scalar @good, " of $total versions/configurations.\n\n";
-exit scalar @bad;
+exit $rep->finish;
sub runit
{
# TODO -- portability alert!!
- my $cmd = shift;
- print "\n Running [$cmd]\n" if $verbose;
+ my($cmd, $warn) = @_;
+ $rep->vsay("\n Running [$cmd]");
my $output = `$cmd 2>&1`;
$output = "\n" unless defined $output;
- $output =~ s/^/ /gm;
- print "\n Output\n$output\n" if $verbose || $?;
+ $output =~ s/^/ > /gm;
+ $rep->say("\n Output:\n$output") if $OPT{verbose} || $?;
if ($?) {
- warn " Running '$cmd' failed: $?\n";
+ $rep->warn(" Running '$cmd' failed: $?\n");
return 0;
}
+ push @$warn, $output =~ /(warning: .*)/ig;
return 1;
}
5.005 5.00501 5.00502 5.00503 5.00504
5.6.0 5.6.1 5.6.2
5.7.0 5.7.1 5.7.2 5.7.3
- 5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6
- 5.9.0 5.9.1
+ 5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6 5.8.7 5.8.8
+ 5.9.0 5.9.1 5.9.2 5.9.3
);
print "Searching for Perl binaries...\n";
- my $mm = MM->new( { NAME => 'dummy' });
- my @path = $mm->path;
- my @GoodPerls;
# find_perl will send a warning to STDOUT if it can't find
# the requested perl, so need to temporarily silence STDOUT.
tie *STDOUT, 'NoSTDOUT';
+ my $mm = MM->new( { NAME => 'dummy' });
+ my @path = $mm->path;
+ my @GoodPerls;
+
for my $perl (@PerlBinaries) {
if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) {
push @GoodPerls, $abs;
and perl_version($File::Find::name)
and push @found, $File::Find::name;
}, $arg);
- printf "Found %d Perl binar%s in '%s'.\n\n", scalar @found, @found == 1 ? 'y' : 'ies', $arg;
+ printf "Found %d Perl binar%s in '%s'.\n\n", cs(@found, 'y', 'ies'), $arg;
push @perls, @found;
}
else {
sub PRINT {}
sub WRITE {}
+package Soak::Reporter;
+
+use strict;
+
+sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }
+
+sub new
+{
+ my $class = shift;
+ bless {
+ color => 1,
+ verbose => 0,
+ @_,
+ _atbol => 1,
+ _total => 0,
+ _good => [],
+ _bad => [],
+ }, $class;
+}
+
+sub colored
+{
+ my $self = shift;
+
+ if ($self->{color}) {
+ my $c = eval {
+ require Term::ANSIColor;
+ Term::ANSIColor::colored(@_);
+ };
+
+ if ($@) {
+ $self->{color} = 0;
+ }
+ else {
+ return $c;
+ }
+ }
+
+ return $_[0];
+}
+
+sub _config
+{
+ my $self = shift;
+ return $self->{config} =~ /\S+/ ? " ($self->{config})" : '';
+}
+
+sub _test
+{
+ my $self = shift;
+ return "Testing "
+ . $self->colored($self->{perl}, 'blue')
+ . $self->colored($self->_config, 'green');
+}
+
+sub _testlen
+{
+ my $self = shift;
+ return length("Testing " . $self->{perl} . $self->_config);
+}
+
+sub _dots
+{
+ my $self = shift;
+ return '.' x $self->_dotslen;
+}
+
+sub _dotslen
+{
+ my $self = shift;
+ return $self->{width} - length($self->{perl} . $self->_config);
+}
+
+sub _sep
+{
+ my $self = shift;
+ my $width = shift;
+ $self->print($self->colored('-'x$width, 'bold'), "\n");
+}
+
+sub _vsep
+{
+ goto &_sep if $_[0]->{verbose};
+}
+
+sub set
+{
+ my $self = shift;
+ while (@_) {
+ my($k, $v) = splice @_, 0, 2;
+ $self->{$k} = $v;
+ }
+}
+
+sub test
+{
+ my $self = shift;
+ $self->_vsep($self->_testlen);
+ $self->print($self->_test, $self->{verbose} ? "\n" : ' ' . $self->_dots . ' ');
+ $self->_vsep($self->_testlen);
+}
+
+sub _warnings
+{
+ my($self, $mode) = @_;
+
+ my $warnings = 0;
+ my $differ = 0;
+
+ for my $w (@{$self->{_warnings}}) {
+ if (@{$w->[1]}) {
+ $warnings += @{$w->[1]};
+ $differ++;
+ }
+ }
+
+ my $rv = '';
+
+ if ($warnings) {
+ if ($mode eq 'summary') {
+ $rv .= sprintf " (%d warning%s", cs($warnings);
+ }
+ else {
+ $rv .= "\n";
+ }
+
+ for my $w (@{$self->{_warnings}}) {
+ if (@{$w->[1]}) {
+ if ($mode eq 'detail') {
+ $rv .= " Warnings during '$w->[0]':\n";
+ my $cnt = 1;
+ for my $msg (@{$w->[1]}) {
+ $rv .= sprintf " [%d] %s", $cnt++, $msg;
+ }
+ $rv .= "\n";
+ }
+ else {
+ unless ($self->{verbose}) {
+ $rv .= $differ == 1 ? " during " . $w->[0]
+ : sprintf(", %d during %s", scalar @{$w->[1]}, $w->[0]);
+ }
+ }
+ }
+ }
+
+ if ($mode eq 'summary') {
+ $rv .= ')';
+ }
+ }
+
+ return $rv;
+}
+
+sub _result
+{
+ my($self, $text, $color) = @_;
+ my $sum = $self->_warnings('summary');
+ my $len = $self->_testlen + $self->_dotslen + length($text) + length($sum) + 2;
+
+ $self->_vsep($len);
+ $self->print($self->_test, ' ', $self->_dots, ' ') if $self->{verbose} || $self->{_atbol};
+ $self->print($self->colored($text, $color));
+ $self->print($self->colored($sum, 'red'));
+ $self->print("\n");
+ $self->_vsep($len);
+ $self->print($self->_warnings('detail')) if $self->{verbose};
+ $self->{_total}++;
+}
+
+sub passed
+{
+ my $self = shift;
+ $self->_result(@_, 'ok', 'bold green');
+ push @{$self->{_good}}, [$self->{perl}, $self->{config}];
+}
+
+sub failed
+{
+ my $self = shift;
+ $self->_result(@_, 'not ok', 'bold red');
+ push @{$self->{_bad}}, [$self->{perl}, $self->{config}];
+}
+
+sub warnings
+{
+ my $self = shift;
+ $self->{_warnings} = \@_;
+}
+
+sub _tobol
+{
+ my $self = shift;
+ print "\n" unless $self->{_atbol};
+ $self->{_atbol} = 1;
+}
+
+sub print
+{
+ my $self = shift;
+ my $text = join '', @_;
+ print $text;
+ $self->{_atbol} = $text =~ /[\r\n]$/;
+}
+
+sub say
+{
+ my $self = shift;
+ $self->_tobol;
+ $self->print(@_, "\n");
+}
+
+sub vsay
+{
+ goto &say if $_[0]->{verbose};
+}
+
+sub warn
+{
+ my $self = shift;
+ $self->say($self->colored(join('', @_), 'red'));
+}
+
+sub die
+{
+ my $self = shift;
+ $self->say($self->colored(join('', 'FATAL: ', @_), 'bold red'));
+ exit -1;
+}
+
+sub status
+{
+ my($self, $text) = @_;
+ $self->_tobol;
+ $self->print($self->colored($text, 'bold'), "\n");
+}
+
+sub finish
+{
+ my $self = shift;
+
+ if (@{$self->{_bad}}) {
+ $self->status("\nFailed with:");
+ for my $fail (@{$self->{_bad}}) {
+ my($perl, $cfg) = @$fail;
+ $self->set(config => $cfg);
+ $self->say(" ", $self->colored($perl, 'blue'), $self->colored($self->_config, 'green'));
+ }
+ }
+
+ $self->status(sprintf("\nPassed with %d of %d combination%s.\n",
+ scalar @{$self->{_good}}, cs($self->{_total})));
+
+ return scalar @{$self->{_bad}};
+}
+
__END__
=head1 NAME
--min=version use at least this version of perl
--mmargs=options pass options to Makefile.PL (multiple --mmargs possible)
--verbose be verbose
+ --nocolor don't use colored output
+
+=head1 DESCRIPTION
+
+The F<soak> utility can be used to test Perl modules with
+multiple Perl releases or build options. It automates the
+task of running F<Makefile.PL> and the modules test suite.
+
+It is not primarily intended for cross-platform checking,
+so don't expect it to work on all platforms.
+
+=head1 EXAMPLES
+
+To test your favourite module, just change to its root
+directory (where the F<Makefile.PL> is located) and run:
+
+ soak
+
+This will automatically look for Perl binaries installed
+on your system.
+
+Alternatively, you can explicitly pass F<soak> a list of
+Perl binaries:
+
+ soak perl5.8.6 perl5.9.2
+
+Last but not least, you can pass it a list of directories
+to recursively search for Perl binaries, for example:
+
+ soak /tmp/perl/install /usr/bin
+
+All of the above examples will run
+
+ perl Makefile.PL
+ make
+ make test
+
+for your module and report success or failure.
+
+If your F<Makefile.PL> can take arguments, you may also
+want to test different configurations for your module.
+You can do so with the I<--mmargs> option:
+
+ soak --mmargs=' ' --mmargs='CCFLAGS=-Wextra' --mmargs='enable-debug'
+
+This will run
+
+ perl Makefile.PL
+ make
+ make test
+ perl Makefile.PL CCFLAGS=-Wextra
+ make
+ make test
+ perl Makefile.PL enable-debug
+ make
+ make test
+
+for each Perl binary.
+
+If you have a directory full of different Perl binaries,
+but your module isn't expected to work with ancient perls,
+you can use the I<--min> option to specify the minimum
+version a Perl binary must have to be chosen for testing:
+
+ soak --min=5.8.1
+
+Usually, the output of F<soak> is rather terse, to give
+you a good overview. If you'd like to see more of what's
+going on, use the I<--verbose> option:
+
+ soak --verbose
=head1 COPYRIGHT
projects / p5sagit/p5-mst-13.2.git / blobdiff