2 ################################################################################
4 # soak -- Test Perl modules with multiple Perl releases.
6 # Original Author: Paul Marquess
8 ################################################################################
12 # $Date: 2006/12/02 13:31:24 +0100 $
14 ################################################################################
16 # Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
17 # Version 2.x, Copyright (C) 2001, Paul Marquess.
18 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
20 # This program is free software; you can redistribute it and/or
21 # modify it under the same terms as Perl itself.
23 ################################################################################
29 use ExtUtils::MakeMaker;
33 use List::Util qw(max);
36 my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.10_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
41 make => $Config{make} || 'make',
46 GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@ color!)) or pod2usage(2);
48 $OPT{mmargs} = [''] unless exists $OPT{mmargs};
49 $OPT{min} = parse_version($OPT{min}) - 1e-10;
51 sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }
53 my @GoodPerls = map { $_->[0] }
54 sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
55 grep { $_->[1] >= $OPT{min} }
56 map { [$_ => perl_version($_)] }
57 @ARGV ? SearchPerls(@ARGV) : FindPerls();
60 print "Sorry, got no Perl binaries for testing.\n\n";
64 my $maxlen = max(map length, @GoodPerls) + 3;
65 my $mmalen = max(map length, @{$OPT{mmargs}});
66 $maxlen += $mmalen+3 if $mmalen > 0;
68 my $rep = Soak::Reporter->new( verbose => $OPT{verbose}
69 , color => $OPT{color}
73 $SIG{__WARN__} = sub { $rep->warn(@_) };
74 $SIG{__DIE__} = sub { $rep->die(@_) };
76 # prime the pump, so the first "make realclean" will work.
77 runit("$^X Makefile.PL") && runit("$OPT{make} realclean")
78 or $rep->die("Cannot run $^X Makefile.PL && $OPT{make} realclean\n");
80 my $tot = @GoodPerls*@{$OPT{mmargs}};
82 $rep->set(tests => $tot);
84 $rep->status(sprintf("Testing %d version%s / %d configuration%s (%d combination%s)...\n",
85 cs(@GoodPerls), cs(@{$OPT{mmargs}}), cs($tot)));
87 for my $perl (@GoodPerls) {
88 for my $mm (@{$OPT{mmargs}}) {
89 $rep->set(perl => $perl, config => $mm);
97 my $ok = runit("$perl Makefile.PL $mm", \@warn_mfpl) &&
98 runit("$OPT{make}", \@warn_make) &&
99 runit("$OPT{make} test", \@warn_test);
101 $rep->warnings(['Makefile.PL' => \@warn_mfpl],
102 ['make' => \@warn_make],
103 ['make test' => \@warn_test]);
112 runit("$OPT{make} realclean");
120 # TODO -- portability alert!!
122 my($cmd, $warn) = @_;
123 $rep->vsay("\n Running [$cmd]");
124 my $output = `$cmd 2>&1`;
125 $output = "\n" unless defined $output;
126 $output =~ s/^/ > /gm;
127 $rep->say("\n Output:\n$output") if $OPT{verbose} || $?;
129 $rep->warn(" Running '$cmd' failed: $?\n");
132 push @$warn, $output =~ /(warning: .*)/ig;
138 # TODO -- need to decide how far back we go.
139 # TODO -- get list of user releases prior to 5.004
140 # TODO -- does not work on Windows (at least)
142 # find versions of Perl that are available
143 my @PerlBinaries = qw(
148 5.004 5.00401 5.00402 5.00403 5.00404 5.00405
149 5.005 5.00501 5.00502 5.00503 5.00504
151 5.7.0 5.7.1 5.7.2 5.7.3
152 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
153 5.9.0 5.9.1 5.9.2 5.9.3
156 print "Searching for Perl binaries...\n";
158 # find_perl will send a warning to STDOUT if it can't find
159 # the requested perl, so need to temporarily silence STDOUT.
160 tie *STDOUT, 'NoSTDOUT';
162 my $mm = MM->new( { NAME => 'dummy' });
163 my @path = $mm->path;
166 for my $perl (@PerlBinaries) {
167 if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) {
168 push @GoodPerls, $abs;
174 print "\nFound:\n", (map " $_\n", @GoodPerls), "\n";
184 for my $arg (@args) {
187 print "Searching for Perl binaries in '$arg'...\n";
189 $File::Find::name =~ m!perl5[\w._]+$!
190 and -f $File::Find::name
191 and -x $File::Find::name
192 and perl_version($File::Find::name)
193 and push @found, $File::Find::name;
195 printf "Found %d Perl binar%s in '%s'.\n\n", cs(@found, 'y', 'ies'), $arg;
209 my $ver = `$perl -e 'print \$]' 2>&1`;
210 return $? == 0 && $ver >= 5 ? $ver : 0;
217 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
218 return $1 + 1e-3*$2 + 1e-6*$3;
220 elsif ($ver =~ /^\d+\.[\d_]+$/) {
225 die "cannot parse version '$ver'\n";
231 our @ISA = qw(Tie::Handle);
233 sub TIEHANDLE { bless \(my $s = ''), shift }
237 package Soak::Reporter;
241 sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }
263 if ($self->{color}) {
265 require Term::ANSIColor;
266 Term::ANSIColor::colored(@_);
283 return $self->{config} =~ /\S+/ ? " ($self->{config})" : '';
289 return '' unless defined $self->{tests};
290 my $tlen = length $self->{tests};
291 my $text = sprintf "[%${tlen}d/%${tlen}d] ", $self->{_cur}, $self->{tests};
292 return $self->colored($text, 'bold');
298 return $self->_progress . "Testing "
299 . $self->colored($self->{perl}, 'blue')
300 . $self->colored($self->_config, 'green');
306 return length("Testing " . $self->{perl} . $self->_config);
312 return '.' x $self->_dotslen;
318 return $self->{width} - length($self->{perl} . $self->_config);
325 $self->print($self->colored('-'x$width, 'bold'), "\n");
330 goto &_sep if $_[0]->{verbose};
337 my($k, $v) = splice @_, 0, 2;
346 $self->_vsep($self->_testlen);
347 $self->print($self->_test, $self->{verbose} ? "\n" : ' ' . $self->_dots . ' ');
348 $self->_vsep($self->_testlen);
353 my($self, $mode) = @_;
358 for my $w (@{$self->{_warnings}}) {
360 $warnings += @{$w->[1]};
368 if ($mode eq 'summary') {
369 $rv .= sprintf " (%d warning%s", cs($warnings);
375 for my $w (@{$self->{_warnings}}) {
377 if ($mode eq 'detail') {
378 $rv .= " Warnings during '$w->[0]':\n";
380 for my $msg (@{$w->[1]}) {
381 $rv .= sprintf " [%d] %s", $cnt++, $msg;
386 unless ($self->{verbose}) {
387 $rv .= $differ == 1 ? " during " . $w->[0]
388 : sprintf(", %d during %s", scalar @{$w->[1]}, $w->[0]);
394 if ($mode eq 'summary') {
404 my($self, $text, $color) = @_;
405 my $sum = $self->_warnings('summary');
406 my $len = $self->_testlen + $self->_dotslen + length($text) + length($sum) + 2;
409 $self->print($self->_test, ' ', $self->_dots, ' ') if $self->{verbose} || $self->{_atbol};
410 $self->print($self->colored($text, $color));
411 $self->print($self->colored($sum, 'red'));
414 $self->print($self->_warnings('detail')) if $self->{verbose};
421 $self->_result(@_, 'ok', 'bold green');
422 push @{$self->{_good}}, [$self->{perl}, $self->{config}];
428 $self->_result(@_, 'not ok', 'bold red');
429 push @{$self->{_bad}}, [$self->{perl}, $self->{config}];
435 $self->{_warnings} = \@_;
441 print "\n" unless $self->{_atbol};
448 my $text = join '', @_;
450 $self->{_atbol} = $text =~ /[\r\n]$/;
457 $self->print(@_, "\n");
462 goto &say if $_[0]->{verbose};
468 $self->say($self->colored(join('', @_), 'red'));
474 $self->say($self->colored(join('', 'FATAL: ', @_), 'bold red'));
480 my($self, $text) = @_;
482 $self->print($self->colored($text, 'bold'), "\n");
489 if (@{$self->{_bad}}) {
490 $self->status("\nFailed with:");
491 for my $fail (@{$self->{_bad}}) {
492 my($perl, $cfg) = @$fail;
493 $self->set(config => $cfg);
494 $self->say(" ", $self->colored($perl, 'blue'), $self->colored($self->_config, 'green'));
498 $self->status(sprintf("\nPassed with %d of %d combination%s.\n",
499 scalar @{$self->{_good}}, cs($self->{_total})));
501 return scalar @{$self->{_bad}};
508 soak - Test Perl modules with multiple Perl releases
512 soak [options] [perl ...]
514 --make=program override name of make program ($Config{make})
515 --min=version use at least this version of perl
516 --mmargs=options pass options to Makefile.PL (multiple --mmargs possible)
518 --nocolor don't use colored output
522 The F<soak> utility can be used to test Perl modules with
523 multiple Perl releases or build options. It automates the
524 task of running F<Makefile.PL> and the modules test suite.
526 It is not primarily intended for cross-platform checking,
527 so don't expect it to work on all platforms.
531 To test your favourite module, just change to its root
532 directory (where the F<Makefile.PL> is located) and run:
536 This will automatically look for Perl binaries installed
539 Alternatively, you can explicitly pass F<soak> a list of
542 soak perl5.8.6 perl5.9.2
544 Last but not least, you can pass it a list of directories
545 to recursively search for Perl binaries, for example:
547 soak /tmp/perl/install /usr/bin
549 All of the above examples will run
555 for your module and report success or failure.
557 If your F<Makefile.PL> can take arguments, you may also
558 want to test different configurations for your module.
559 You can do so with the I<--mmargs> option:
561 soak --mmargs=' ' --mmargs='CCFLAGS=-Wextra' --mmargs='enable-debug'
568 perl Makefile.PL CCFLAGS=-Wextra
571 perl Makefile.PL enable-debug
575 for each Perl binary.
577 If you have a directory full of different Perl binaries,
578 but your module isn't expected to work with ancient perls,
579 you can use the I<--min> option to specify the minimum
580 version a Perl binary must have to be chosen for testing:
584 Usually, the output of F<soak> is rather terse, to give
585 you a good overview. If you'd like to see more of what's
586 going on, use the I<--verbose> option:
592 Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz.
594 Version 2.x, Copyright (C) 2001, Paul Marquess.
596 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
598 This program is free software; you can redistribute it and/or
599 modify it under the same terms as Perl itself.
603 See L<Devel::PPPort>.