Upgrade to Devel::PPPort 3.07

[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / soak

#!/usr/bin/perl -w
################################################################################
#
#  soak -- Test Perl modules with multiple Perl releases.
#
#  Original Author: Paul Marquess
#
################################################################################
#
#  $Revision: 9 $
#  $Author: mhx $
#  $Date: 2006/01/14 18:07:57 +0100 $
#
################################################################################
#
#  Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
#  Version 2.x, Copyright (C) 2001, Paul Marquess.
#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.
#
################################################################################

require 5.006001;

use strict;
use warnings;
use ExtUtils::MakeMaker;
use Getopt::Long;
use Pod::Usage;
use List::Util qw(max);
use Config;

my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.07 $' =~ /(\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',
);

GetOptions(\%OPT, qw(verbose make=s mmargs=s@)) or pod2usage(2);

$OPT{mmargs} = [''] unless exists $OPT{mmargs};

my @GoodPerls = @ARGV ? @ARGV : FindPerls();
my $maxlen = max(map length, @GoodPerls) + 3;
my $mmalen = max(map length, @{$OPT{mmargs}});
$maxlen += $mmalen+3 if $mmalen > 0;

# run each through the test harness
my(@good, @bad, $total);

# 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";

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)));

    my $ok = runit("$perl Makefile.PL $mm") &&
             # runit("$perl Makefile.PL --with-apicheck") &&
             runit("$MAKE test");

    $total++;
    if ($ok) {
      push @good, [$perl, $mm];
      print "${prefix}ok\n";
    }
    else {
      push @bad, [$perl, $mm];
      print "${prefix}not ok\n";
    }

    runit("$MAKE realclean");
  }
}

if ($verbose && @bad) {
  print "\nFailed with:\n", map "    $_\n", @bad;
}
print "\nPassed with ", scalar @good, " of $total versions/configurations.\n\n";
exit scalar @bad;

sub runit
{
  # TODO -- portability alert!!

  my $cmd = shift;
  print "\n    Running [$cmd]\n" if $verbose;
  my $output = `$cmd 2>&1`;
  $output = "\n" unless defined $output;
  $output =~ s/^/      /gm;
  print "\n    Output\n$output\n" if $verbose || $?;
  if ($?) {
    warn "    Running '$cmd' failed: $?\n";
    return 0;
  }
  return 1;
}

sub FindPerls
{
  # TODO -- need to decide how far back we go.
  # TODO -- get list of user releases prior to 5.004
  # TODO -- does not work on Windows (at least)

  # find versions of Perl that are available
  my @PerlBinaries = qw(
    5.000
    5.001
    5.002
    5.003
    5.004 5.00401 5.00402 5.00403 5.00404 5.00405
    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
  );

  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';

  for my $perl (@PerlBinaries) {
    if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) {
      push @GoodPerls, $abs;
    }
  }

  untie *STDOUT;

  print "\nFound:\n", (map "    $_\n", @GoodPerls), "\n";

  return @GoodPerls;
}

package NoSTDOUT;

use Tie::Handle;
our @ISA = qw(Tie::Handle);

sub TIEHANDLE { bless \(my $s = ''), shift }
sub PRINT {}
sub WRITE {}

__END__

=head1 NAME

soak - Test Perl modules with multiple Perl releases

=head1 SYNOPSIS

  soak [options] [perl ...]

  --make=program     override name of make program ($Config{make})
  --mmargs=options   pass options to Makefile.PL (multiple --mmargs possible)
  --verbose          be verbose

=head1 COPYRIGHT

Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz.

Version 2.x, Copyright (C) 2001, Paul Marquess.

Version 1.x, Copyright (C) 1999, Kenneth Albanowski.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

See L<Devel::PPPort>.

=cut