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