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 | # |
0c96388f |
10 | # $Revision: 12 $ |
adfe19db |
11 | # $Author: mhx $ |
0c96388f |
12 | # $Date: 2006/05/22 20:26:02 +0200 $ |
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; |
c07deaaf |
32 | use File::Find; |
4a582685 |
33 | use List::Util qw(max); |
34 | use Config; |
44284200 |
35 | |
0c96388f |
36 | my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; |
0a7c7f4f |
37 | |
4a582685 |
38 | $| = 1; |
39 | my $verbose = 0; |
40 | my $MAKE = $Config{make} || 'make'; |
41 | my %OPT = ( |
42 | verbose => 0, |
43 | make => $Config{make} || 'make', |
c07deaaf |
44 | min => '5.000', |
4a582685 |
45 | ); |
0a7c7f4f |
46 | |
c07deaaf |
47 | GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@)) or pod2usage(2); |
dbda3434 |
48 | |
4a582685 |
49 | $OPT{mmargs} = [''] unless exists $OPT{mmargs}; |
c07deaaf |
50 | $OPT{min} = parse_version($OPT{min}) - 1e-10; |
dbda3434 |
51 | |
0c96388f |
52 | my @GoodPerls = map { $_->[0] } |
53 | sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] } |
54 | grep { $_->[1] >= $OPT{min} } |
55 | map { [$_ => perl_version($_)] } |
c07deaaf |
56 | @ARGV ? SearchPerls(@ARGV) : FindPerls(); |
0c96388f |
57 | |
58 | unless (@GoodPerls) { |
59 | print "Sorry, got no Perl binaries for testing.\n\n"; |
60 | exit 0; |
61 | } |
62 | |
4a582685 |
63 | my $maxlen = max(map length, @GoodPerls) + 3; |
64 | my $mmalen = max(map length, @{$OPT{mmargs}}); |
65 | $maxlen += $mmalen+3 if $mmalen > 0; |
0a7c7f4f |
66 | |
67 | # run each through the test harness |
4a582685 |
68 | my(@good, @bad, $total); |
0a7c7f4f |
69 | |
adfe19db |
70 | # prime the pump, so the first "make realclean" will work. |
4a582685 |
71 | runit("$^X Makefile.PL") && runit("$MAKE realclean") |
72 | or die "Cannot run $^X Makefile.PL && $MAKE realclean\n"; |
dbda3434 |
73 | |
c07deaaf |
74 | print "Testing ", scalar @GoodPerls, " versions/configurations...\n\n"; |
75 | |
4a582685 |
76 | for my $perl (@GoodPerls) { |
77 | for my $mm (@{$OPT{mmargs}}) { |
78 | my $config = $mm =~ /\S+/ ? " ($mm)" : ''; |
79 | my $prefix = $verbose ? "$perl$config -- " : ''; |
80 | print "Testing $perl$config " . ('.' x ($maxlen - length($perl.$config))); |
dbda3434 |
81 | |
4a582685 |
82 | my $ok = runit("$perl Makefile.PL $mm") && |
83 | # runit("$perl Makefile.PL --with-apicheck") && |
84 | runit("$MAKE test"); |
0a7c7f4f |
85 | |
4a582685 |
86 | $total++; |
0a7c7f4f |
87 | if ($ok) { |
4a582685 |
88 | push @good, [$perl, $mm]; |
89 | print "${prefix}ok\n"; |
0a7c7f4f |
90 | } |
91 | else { |
4a582685 |
92 | push @bad, [$perl, $mm]; |
93 | print "${prefix}not ok\n"; |
0a7c7f4f |
94 | } |
95 | |
4a582685 |
96 | runit("$MAKE realclean"); |
97 | } |
0a7c7f4f |
98 | } |
99 | |
c07deaaf |
100 | if (@bad) { |
101 | print "\nFailed with:\n"; |
102 | for my $fail (@bad) { |
103 | my($perl, $mm) = @$fail; |
104 | my $config = $mm =~ /\S+/ ? " ($mm)" : ''; |
105 | print " $perl$config\n"; |
106 | } |
4a582685 |
107 | } |
c07deaaf |
108 | |
4a582685 |
109 | print "\nPassed with ", scalar @good, " of $total versions/configurations.\n\n"; |
110 | exit scalar @bad; |
0a7c7f4f |
111 | |
112 | sub runit |
113 | { |
4a582685 |
114 | # TODO -- portability alert!! |
115 | |
116 | my $cmd = shift; |
117 | print "\n Running [$cmd]\n" if $verbose; |
118 | my $output = `$cmd 2>&1`; |
119 | $output = "\n" unless defined $output; |
120 | $output =~ s/^/ /gm; |
121 | print "\n Output\n$output\n" if $verbose || $?; |
122 | if ($?) { |
123 | warn " Running '$cmd' failed: $?\n"; |
124 | return 0; |
125 | } |
126 | return 1; |
44284200 |
127 | } |
128 | |
129 | sub FindPerls |
130 | { |
4a582685 |
131 | # TODO -- need to decide how far back we go. |
132 | # TODO -- get list of user releases prior to 5.004 |
133 | # TODO -- does not work on Windows (at least) |
134 | |
135 | # find versions of Perl that are available |
136 | my @PerlBinaries = qw( |
137 | 5.000 |
138 | 5.001 |
139 | 5.002 |
140 | 5.003 |
141 | 5.004 5.00401 5.00402 5.00403 5.00404 5.00405 |
142 | 5.005 5.00501 5.00502 5.00503 5.00504 |
143 | 5.6.0 5.6.1 5.6.2 |
144 | 5.7.0 5.7.1 5.7.2 5.7.3 |
145 | 5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6 |
146 | 5.9.0 5.9.1 |
147 | ); |
148 | |
149 | print "Searching for Perl binaries...\n"; |
150 | my $mm = MM->new( { NAME => 'dummy' }); |
151 | my @path = $mm->path; |
152 | my @GoodPerls; |
153 | |
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'; |
157 | |
158 | for my $perl (@PerlBinaries) { |
159 | if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) { |
160 | push @GoodPerls, $abs; |
44284200 |
161 | } |
4a582685 |
162 | } |
163 | |
164 | untie *STDOUT; |
44284200 |
165 | |
4a582685 |
166 | print "\nFound:\n", (map " $_\n", @GoodPerls), "\n"; |
167 | |
168 | return @GoodPerls; |
44284200 |
169 | } |
170 | |
c07deaaf |
171 | sub SearchPerls |
172 | { |
173 | my @args = @_; |
174 | my @perls; |
175 | |
176 | for my $arg (@args) { |
177 | if (-d $arg) { |
178 | my @found; |
179 | print "Searching for Perl binaries in '$arg'...\n"; |
180 | find(sub { |
0c96388f |
181 | $File::Find::name =~ m!perl5[\w._]+$! |
182 | and -f $File::Find::name |
183 | and -x $File::Find::name |
184 | and perl_version($File::Find::name) |
185 | and push @found, $File::Find::name; |
c07deaaf |
186 | }, $arg); |
187 | printf "Found %d Perl binar%s in '%s'.\n\n", scalar @found, @found == 1 ? 'y' : 'ies', $arg; |
188 | push @perls, @found; |
189 | } |
190 | else { |
191 | push @perls, $arg; |
192 | } |
193 | } |
194 | |
195 | return @perls; |
196 | } |
197 | |
0c96388f |
198 | sub perl_version |
199 | { |
200 | my $perl = shift; |
201 | my $ver = `$perl -e 'print \$]' 2>&1`; |
202 | return $? == 0 && $ver >= 5 ? $ver : 0; |
203 | } |
204 | |
c07deaaf |
205 | sub parse_version |
206 | { |
207 | my $ver = shift; |
208 | |
c07deaaf |
209 | if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { |
210 | return $1 + 1e-3*$2 + 1e-6*$3; |
211 | } |
212 | elsif ($ver =~ /^\d+\.[\d_]+$/) { |
213 | $ver =~ s/_//g; |
214 | return $ver; |
215 | } |
216 | |
217 | die "cannot parse version '$ver'\n"; |
218 | } |
219 | |
44284200 |
220 | package NoSTDOUT; |
221 | |
222 | use Tie::Handle; |
223 | our @ISA = qw(Tie::Handle); |
224 | |
4a582685 |
225 | sub TIEHANDLE { bless \(my $s = ''), shift } |
226 | sub PRINT {} |
227 | sub WRITE {} |
228 | |
229 | __END__ |
230 | |
231 | =head1 NAME |
232 | |
233 | soak - Test Perl modules with multiple Perl releases |
234 | |
235 | =head1 SYNOPSIS |
236 | |
237 | soak [options] [perl ...] |
238 | |
239 | --make=program override name of make program ($Config{make}) |
c07deaaf |
240 | --min=version use at least this version of perl |
4a582685 |
241 | --mmargs=options pass options to Makefile.PL (multiple --mmargs possible) |
242 | --verbose be verbose |
243 | |
244 | =head1 COPYRIGHT |
245 | |
0d0f8426 |
246 | Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz. |
4a582685 |
247 | |
248 | Version 2.x, Copyright (C) 2001, Paul Marquess. |
249 | |
250 | Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
251 | |
252 | This program is free software; you can redistribute it and/or |
253 | modify it under the same terms as Perl itself. |
254 | |
255 | =head1 SEE ALSO |
256 | |
257 | See L<Devel::PPPort>. |
adfe19db |
258 | |
4a582685 |
259 | =cut |
adfe19db |
260 | |