#!/usr/bin/perl -w ################################################################################ # # soak -- Test Devel::PPPort with multiple versions of Perl. # # Original Author: Paul Marquess # ################################################################################ # # $Revision: 7 $ # $Author: mhx $ # $Date: 2005/01/31 08:10:55 +0100 $ # ################################################################################ # # Version 3.x, Copyright (C) 2004-2005, 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; my $VERSION = "1.000"; $| = 1 ; my $verbose = 0 ; # TODO -- determine what "make" program to run. my $MAKE = 'make'; my $result = GetOptions( "verbose" => \$verbose, "make=s" => \$MAKE, ) or Usage(); my @GoodPerls = (); if (@ARGV) { @GoodPerls = @ARGV } else { @GoodPerls = FindPerls() } my $maxlen = 0; foreach (@GoodPerls) { $maxlen = length $_ if length $_ > $maxlen ; } $maxlen += 3 ; # run each through the test harness my $bad = 0 ; my $good = 0 ; my $total = 0 ; # prime the pump, so the first "make realclean" will work. runit("perl Makefile.PL") || die "Cannot run perl Makefile.PL\n" ; foreach my $perl (@GoodPerls) { my $prefix = $verbose ? "$perl -- " : ''; print "Testing $perl " . ('.' x ($maxlen - length $perl)) ; my $ok = runit("$MAKE realclean") && runit("$perl Makefile.PL") && # runit("$perl Makefile.PL --with-apicheck") && 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\n"; exit $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 Usage { die <new( { NAME => 'dummy' }); my @path = $mm->path(); # 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'); foreach my $perl (@PerlBinaries) { if (my $abs = $mm->find_perl($perl, ["perl$perl"], [@path], 0)) { push @GoodPerls, $abs ; } } untie *STDOUT; print "\n\nFound\n"; foreach (@GoodPerls) { print " $_\n" } print "\n\n"; return @GoodPerls; } package NoSTDOUT; use Tie::Handle; our @ISA = qw(Tie::Handle); sub TIEHANDLE { my ($class) = @_; my $buf = ""; bless \$buf, $class; } sub PRINT { my $self = shift; } sub WRITE { my $self = shift; }