2 ################################################################################
4 # soak -- Test Perl modules with multiple Perl releases.
6 # Original Author: Paul Marquess
8 ################################################################################
12 # $Date: 2006/07/08 16:58:56 +0200 $
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.09_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 $rep->status(sprintf("Testing %d version%s / %d configuration%s (%d combination%s)...\n",
81 cs(@GoodPerls), cs(@{$OPT{mmargs}}), cs(@GoodPerls*@{$OPT{mmargs}})));
83 for my $perl (@GoodPerls) {
84 for my $mm (@{$OPT{mmargs}}) {
85 $rep->set(perl => $perl, config => $mm);
93 my $ok = runit("$perl Makefile.PL $mm", \@warn_mfpl) &&
94 runit("$OPT{make}", \@warn_make) &&
95 runit("$OPT{make} test", \@warn_test);
97 $rep->warnings(['Makefile.PL' => \@warn_mfpl],
98 ['make' => \@warn_make],
99 ['make test' => \@warn_test]);
108 runit("$OPT{make} realclean");
116 # TODO -- portability alert!!
118 my($cmd, $warn) = @_;
119 $rep->vsay("\n Running [$cmd]");
120 my $output = `$cmd 2>&1`;
121 $output = "\n" unless defined $output;
122 $output =~ s/^/ > /gm;
123 $rep->say("\n Output:\n$output") if $OPT{verbose} || $?;
125 $rep->warn(" Running '$cmd' failed: $?\n");
128 push @$warn, $output =~ /(warning: .*)/ig;
134 # TODO -- need to decide how far back we go.
135 # TODO -- get list of user releases prior to 5.004
136 # TODO -- does not work on Windows (at least)
138 # find versions of Perl that are available
139 my @PerlBinaries = qw(
144 5.004 5.00401 5.00402 5.00403 5.00404 5.00405
145 5.005 5.00501 5.00502 5.00503 5.00504
147 5.7.0 5.7.1 5.7.2 5.7.3
148 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
149 5.9.0 5.9.1 5.9.2 5.9.3
152 print "Searching for Perl binaries...\n";
154 # find_perl will send a warning to STDOUT if it can't find
155 # the requested perl, so need to temporarily silence STDOUT.
156 tie *STDOUT, 'NoSTDOUT';
158 my $mm = MM->new( { NAME => 'dummy' });
159 my @path = $mm->path;
162 for my $perl (@PerlBinaries) {
163 if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) {
164 push @GoodPerls, $abs;
170 print "\nFound:\n", (map " $_\n", @GoodPerls), "\n";
180 for my $arg (@args) {
183 print "Searching for Perl binaries in '$arg'...\n";
185 $File::Find::name =~ m!perl5[\w._]+$!
186 and -f $File::Find::name
187 and -x $File::Find::name
188 and perl_version($File::Find::name)
189 and push @found, $File::Find::name;
191 printf "Found %d Perl binar%s in '%s'.\n\n", cs(@found, 'y', 'ies'), $arg;
205 my $ver = `$perl -e 'print \$]' 2>&1`;
206 return $? == 0 && $ver >= 5 ? $ver : 0;
213 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
214 return $1 + 1e-3*$2 + 1e-6*$3;
216 elsif ($ver =~ /^\d+\.[\d_]+$/) {
221 die "cannot parse version '$ver'\n";
227 our @ISA = qw(Tie::Handle);
229 sub TIEHANDLE { bless \(my $s = ''), shift }
233 package Soak::Reporter;
237 sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }
257 if ($self->{color}) {
259 require Term::ANSIColor;
260 Term::ANSIColor::colored(@_);
277 return $self->{config} =~ /\S+/ ? " ($self->{config})" : '';
284 . $self->colored($self->{perl}, 'blue')
285 . $self->colored($self->_config, 'green');
291 return length("Testing " . $self->{perl} . $self->_config);
297 return '.' x $self->_dotslen;
303 return $self->{width} - length($self->{perl} . $self->_config);
310 $self->print($self->colored('-'x$width, 'bold'), "\n");
315 goto &_sep if $_[0]->{verbose};
322 my($k, $v) = splice @_, 0, 2;
330 $self->_vsep($self->_testlen);
331 $self->print($self->_test, $self->{verbose} ? "\n" : ' ' . $self->_dots . ' ');
332 $self->_vsep($self->_testlen);
337 my($self, $mode) = @_;
342 for my $w (@{$self->{_warnings}}) {
344 $warnings += @{$w->[1]};
352 if ($mode eq 'summary') {
353 $rv .= sprintf " (%d warning%s", cs($warnings);
359 for my $w (@{$self->{_warnings}}) {
361 if ($mode eq 'detail') {
362 $rv .= " Warnings during '$w->[0]':\n";
364 for my $msg (@{$w->[1]}) {
365 $rv .= sprintf " [%d] %s", $cnt++, $msg;
370 unless ($self->{verbose}) {
371 $rv .= $differ == 1 ? " during " . $w->[0]
372 : sprintf(", %d during %s", scalar @{$w->[1]}, $w->[0]);
378 if ($mode eq 'summary') {
388 my($self, $text, $color) = @_;
389 my $sum = $self->_warnings('summary');
390 my $len = $self->_testlen + $self->_dotslen + length($text) + length($sum) + 2;
393 $self->print($self->_test, ' ', $self->_dots, ' ') if $self->{verbose} || $self->{_atbol};
394 $self->print($self->colored($text, $color));
395 $self->print($self->colored($sum, 'red'));
398 $self->print($self->_warnings('detail')) if $self->{verbose};
405 $self->_result(@_, 'ok', 'bold green');
406 push @{$self->{_good}}, [$self->{perl}, $self->{config}];
412 $self->_result(@_, 'not ok', 'bold red');
413 push @{$self->{_bad}}, [$self->{perl}, $self->{config}];
419 $self->{_warnings} = \@_;
425 print "\n" unless $self->{_atbol};
432 my $text = join '', @_;
434 $self->{_atbol} = $text =~ /[\r\n]$/;
441 $self->print(@_, "\n");
446 goto &say if $_[0]->{verbose};
452 $self->say($self->colored(join('', @_), 'red'));
458 $self->say($self->colored(join('', 'FATAL: ', @_), 'bold red'));
464 my($self, $text) = @_;
466 $self->print($self->colored($text, 'bold'), "\n");
473 if (@{$self->{_bad}}) {
474 $self->status("\nFailed with:");
475 for my $fail (@{$self->{_bad}}) {
476 my($perl, $cfg) = @$fail;
477 $self->set(config => $cfg);
478 $self->say(" ", $self->colored($perl, 'blue'), $self->colored($self->_config, 'green'));
482 $self->status(sprintf("\nPassed with %d of %d combination%s.\n",
483 scalar @{$self->{_good}}, cs($self->{_total})));
485 return scalar @{$self->{_bad}};
492 soak - Test Perl modules with multiple Perl releases
496 soak [options] [perl ...]
498 --make=program override name of make program ($Config{make})
499 --min=version use at least this version of perl
500 --mmargs=options pass options to Makefile.PL (multiple --mmargs possible)
502 --nocolor don't use colored output
506 The F<soak> utility can be used to test Perl modules with
507 multiple Perl releases or build options. It automates the
508 task of running F<Makefile.PL> and the modules test suite.
510 It is not primarily intended for cross-platform checking,
511 so don't expect it to work on all platforms.
515 To test your favourite module, just change to its root
516 directory (where the F<Makefile.PL> is located) and run:
520 This will automatically look for Perl binaries installed
523 Alternatively, you can explicitly pass F<soak> a list of
526 soak perl5.8.6 perl5.9.2
528 Last but not least, you can pass it a list of directories
529 to recursively search for Perl binaries, for example:
531 soak /tmp/perl/install /usr/bin
533 All of the above examples will run
539 for your module and report success or failure.
541 If your F<Makefile.PL> can take arguments, you may also
542 want to test different configurations for your module.
543 You can do so with the I<--mmargs> option:
545 soak --mmargs=' ' --mmargs='CCFLAGS=-Wextra' --mmargs='enable-debug'
552 perl Makefile.PL CCFLAGS=-Wextra
555 perl Makefile.PL enable-debug
559 for each Perl binary.
561 If you have a directory full of different Perl binaries,
562 but your module isn't expected to work with ancient perls,
563 you can use the I<--min> option to specify the minimum
564 version a Perl binary must have to be chosen for testing:
568 Usually, the output of F<soak> is rather terse, to give
569 you a good overview. If you'd like to see more of what's
570 going on, use the I<--verbose> option:
576 Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz.
578 Version 2.x, Copyright (C) 2001, Paul Marquess.
580 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
582 This program is free software; you can redistribute it and/or
583 modify it under the same terms as Perl itself.
587 See L<Devel::PPPort>.