Devel::PPPort

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

use strict ;
use ExtUtils::MakeMaker;

$| = 1 ;
my $verbose = 0 ;

# TODO -- Get MM->new to output less MakeMaker progress guff
my $mm = MM->new( { NAME => 'dummy' });

# TODO -- determine what "make" program to run.
my $MAKE = 'make';


# TODO -- need to decide how far back we go.

# find all version of Perl that are available
my @PerlBinaries = qw( 
	5.004        
	5.00401      
	5.00402      
	5.00403      
	5.00404      
	5.00405      
	5.005                         
	5.00501                       
	5.00502      
	5.00503                     
	5.6.0        
	5.6.1 
	5.7.0
	5.7.1
	5.7.2      
	);

print "Searching for Perl binaries...\n" ;
my @GoodPerls = ();
my $maxlen = 0;
my @path = $mm->path();
foreach my $perl (@PerlBinaries) {
    # TODO -- find_perl will send a warning to STDOUT if it can't find 
    #         the requested perl, so need to temporarily close STDOUT.

    if (my $abs = $mm->find_perl($perl, ["perl$perl"], [@path], 0)) {
        push @GoodPerls, $abs ;
        $maxlen = length $abs
             if length $abs > $maxlen ;
    }
}
print "\n\nFound ";
foreach (@GoodPerls) { print "$_\n" }
print "\n\n";
$maxlen += 3 ;

# run each through the test harness

my $bad = 0 ;
my $good = 0 ;
my $total = 0 ;

# prime the pump, so the first "make clean" will work.
runit("perl Makefile.PL") || die "Cannot run perl Makefile.PL\n" ;

foreach my $perl (@GoodPerls)
{
   my $prefix = "$perl -- " if $verbose ;
   print "Testing $perl " . ('.' x ($maxlen - length $perl)) ;

   my $ok = runit("$MAKE clean") &&
            runit("$perl Makefile.PL") &&
            runit("$MAKE test")	;

    ++ $total;
    if ($ok) {
        ++ $good ;
        print "${prefix}ok\n";
    }
    else {
        ++ $bad ;
        print "${prefix}not ok\n" ;
    }

}

print "\n\nPassed with $good of $total versions of Perl.\n";
exit $bad ;


sub runit
{
    # TODO -- portability alert!!

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