Commit | Line | Data |
adfe19db |
1 | #!/usr/bin/perl -w |
2 | ################################################################################ |
3 | # |
4a582685 |
4 | # soak -- Test Perl modules with multiple Perl releases. |
adfe19db |
5 | # |
6 | # Original Author: Paul Marquess |
7 | # |
8 | ################################################################################ |
9 | # |
0d0f8426 |
10 | # $Revision: 9 $ |
adfe19db |
11 | # $Author: mhx $ |
0d0f8426 |
12 | # $Date: 2006/01/14 18:07:57 +0100 $ |
44284200 |
13 | # |
adfe19db |
14 | ################################################################################ |
44284200 |
15 | # |
0d0f8426 |
16 | # Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. |
adfe19db |
17 | # Version 2.x, Copyright (C) 2001, Paul Marquess. |
18 | # Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
19 | # |
20 | # This program is free software; you can redistribute it and/or |
21 | # modify it under the same terms as Perl itself. |
22 | # |
23 | ################################################################################ |
44284200 |
24 | |
25 | require 5.006001; |
dbda3434 |
26 | |
adfe19db |
27 | use strict; |
28 | use warnings; |
dbda3434 |
29 | use ExtUtils::MakeMaker; |
44284200 |
30 | use Getopt::Long; |
4a582685 |
31 | use Pod::Usage; |
32 | use List::Util qw(max); |
33 | use Config; |
44284200 |
34 | |
f2ab5a41 |
35 | my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; |
0a7c7f4f |
36 | |
4a582685 |
37 | $| = 1; |
38 | my $verbose = 0; |
39 | my $MAKE = $Config{make} || 'make'; |
40 | my %OPT = ( |
41 | verbose => 0, |
42 | make => $Config{make} || 'make', |
43 | ); |
0a7c7f4f |
44 | |
4a582685 |
45 | GetOptions(\%OPT, qw(verbose make=s mmargs=s@)) or pod2usage(2); |
dbda3434 |
46 | |
4a582685 |
47 | $OPT{mmargs} = [''] unless exists $OPT{mmargs}; |
dbda3434 |
48 | |
4a582685 |
49 | my @GoodPerls = @ARGV ? @ARGV : FindPerls(); |
50 | my $maxlen = max(map length, @GoodPerls) + 3; |
51 | my $mmalen = max(map length, @{$OPT{mmargs}}); |
52 | $maxlen += $mmalen+3 if $mmalen > 0; |
0a7c7f4f |
53 | |
54 | # run each through the test harness |
4a582685 |
55 | my(@good, @bad, $total); |
0a7c7f4f |
56 | |
adfe19db |
57 | # prime the pump, so the first "make realclean" will work. |
4a582685 |
58 | runit("$^X Makefile.PL") && runit("$MAKE realclean") |
59 | or die "Cannot run $^X Makefile.PL && $MAKE realclean\n"; |
dbda3434 |
60 | |
4a582685 |
61 | for my $perl (@GoodPerls) { |
62 | for my $mm (@{$OPT{mmargs}}) { |
63 | my $config = $mm =~ /\S+/ ? " ($mm)" : ''; |
64 | my $prefix = $verbose ? "$perl$config -- " : ''; |
65 | print "Testing $perl$config " . ('.' x ($maxlen - length($perl.$config))); |
dbda3434 |
66 | |
4a582685 |
67 | my $ok = runit("$perl Makefile.PL $mm") && |
68 | # runit("$perl Makefile.PL --with-apicheck") && |
69 | runit("$MAKE test"); |
0a7c7f4f |
70 | |
4a582685 |
71 | $total++; |
0a7c7f4f |
72 | if ($ok) { |
4a582685 |
73 | push @good, [$perl, $mm]; |
74 | print "${prefix}ok\n"; |
0a7c7f4f |
75 | } |
76 | else { |
4a582685 |
77 | push @bad, [$perl, $mm]; |
78 | print "${prefix}not ok\n"; |
0a7c7f4f |
79 | } |
80 | |
4a582685 |
81 | runit("$MAKE realclean"); |
82 | } |
0a7c7f4f |
83 | } |
84 | |
4a582685 |
85 | if ($verbose && @bad) { |
86 | print "\nFailed with:\n", map " $_\n", @bad; |
87 | } |
88 | print "\nPassed with ", scalar @good, " of $total versions/configurations.\n\n"; |
89 | exit scalar @bad; |
0a7c7f4f |
90 | |
91 | sub runit |
92 | { |
4a582685 |
93 | # TODO -- portability alert!! |
94 | |
95 | my $cmd = shift; |
96 | print "\n Running [$cmd]\n" if $verbose; |
97 | my $output = `$cmd 2>&1`; |
98 | $output = "\n" unless defined $output; |
99 | $output =~ s/^/ /gm; |
100 | print "\n Output\n$output\n" if $verbose || $?; |
101 | if ($?) { |
102 | warn " Running '$cmd' failed: $?\n"; |
103 | return 0; |
104 | } |
105 | return 1; |
44284200 |
106 | } |
107 | |
108 | sub FindPerls |
109 | { |
4a582685 |
110 | # TODO -- need to decide how far back we go. |
111 | # TODO -- get list of user releases prior to 5.004 |
112 | # TODO -- does not work on Windows (at least) |
113 | |
114 | # find versions of Perl that are available |
115 | my @PerlBinaries = qw( |
116 | 5.000 |
117 | 5.001 |
118 | 5.002 |
119 | 5.003 |
120 | 5.004 5.00401 5.00402 5.00403 5.00404 5.00405 |
121 | 5.005 5.00501 5.00502 5.00503 5.00504 |
122 | 5.6.0 5.6.1 5.6.2 |
123 | 5.7.0 5.7.1 5.7.2 5.7.3 |
124 | 5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6 |
125 | 5.9.0 5.9.1 |
126 | ); |
127 | |
128 | print "Searching for Perl binaries...\n"; |
129 | my $mm = MM->new( { NAME => 'dummy' }); |
130 | my @path = $mm->path; |
131 | my @GoodPerls; |
132 | |
133 | # find_perl will send a warning to STDOUT if it can't find |
134 | # the requested perl, so need to temporarily silence STDOUT. |
135 | tie *STDOUT, 'NoSTDOUT'; |
136 | |
137 | for my $perl (@PerlBinaries) { |
138 | if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) { |
139 | push @GoodPerls, $abs; |
44284200 |
140 | } |
4a582685 |
141 | } |
142 | |
143 | untie *STDOUT; |
44284200 |
144 | |
4a582685 |
145 | print "\nFound:\n", (map " $_\n", @GoodPerls), "\n"; |
146 | |
147 | return @GoodPerls; |
44284200 |
148 | } |
149 | |
150 | package NoSTDOUT; |
151 | |
152 | use Tie::Handle; |
153 | our @ISA = qw(Tie::Handle); |
154 | |
4a582685 |
155 | sub TIEHANDLE { bless \(my $s = ''), shift } |
156 | sub PRINT {} |
157 | sub WRITE {} |
158 | |
159 | __END__ |
160 | |
161 | =head1 NAME |
162 | |
163 | soak - Test Perl modules with multiple Perl releases |
164 | |
165 | =head1 SYNOPSIS |
166 | |
167 | soak [options] [perl ...] |
168 | |
169 | --make=program override name of make program ($Config{make}) |
170 | --mmargs=options pass options to Makefile.PL (multiple --mmargs possible) |
171 | --verbose be verbose |
172 | |
173 | =head1 COPYRIGHT |
174 | |
0d0f8426 |
175 | Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz. |
4a582685 |
176 | |
177 | Version 2.x, Copyright (C) 2001, Paul Marquess. |
178 | |
179 | Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
180 | |
181 | This program is free software; you can redistribute it and/or |
182 | modify it under the same terms as Perl itself. |
183 | |
184 | =head1 SEE ALSO |
185 | |
186 | See L<Devel::PPPort>. |
adfe19db |
187 | |
4a582685 |
188 | =cut |
adfe19db |
189 | |