Commit | Line | Data |
adfe19db |
1 | #!/usr/bin/perl -w |
2 | ################################################################################ |
3 | # |
4 | # soak -- Test Devel::PPPort with multiple versions of Perl. |
5 | # |
6 | # Original Author: Paul Marquess |
7 | # |
8 | ################################################################################ |
9 | # |
9132e1a3 |
10 | # $Revision: 7 $ |
adfe19db |
11 | # $Author: mhx $ |
9132e1a3 |
12 | # $Date: 2005/01/31 08:10:55 +0100 $ |
44284200 |
13 | # |
adfe19db |
14 | ################################################################################ |
44284200 |
15 | # |
9132e1a3 |
16 | # Version 3.x, Copyright (C) 2004-2005, 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; |
31 | |
32 | my $VERSION = "1.000"; |
0a7c7f4f |
33 | |
dbda3434 |
34 | $| = 1 ; |
0a7c7f4f |
35 | my $verbose = 0 ; |
36 | |
dbda3434 |
37 | # TODO -- determine what "make" program to run. |
38 | my $MAKE = 'make'; |
39 | |
44284200 |
40 | my $result = GetOptions( |
41 | "verbose" => \$verbose, |
42 | "make=s" => \$MAKE, |
43 | ) or Usage(); |
dbda3434 |
44 | |
44284200 |
45 | my @GoodPerls = (); |
dbda3434 |
46 | |
44284200 |
47 | if (@ARGV) |
48 | { @GoodPerls = @ARGV } |
49 | else |
50 | { @GoodPerls = FindPerls() } |
0a7c7f4f |
51 | |
dbda3434 |
52 | my $maxlen = 0; |
44284200 |
53 | foreach (@GoodPerls) { |
54 | $maxlen = length $_ |
55 | if length $_ > $maxlen ; |
dbda3434 |
56 | } |
0a7c7f4f |
57 | $maxlen += 3 ; |
58 | |
59 | # run each through the test harness |
60 | |
61 | my $bad = 0 ; |
62 | my $good = 0 ; |
63 | my $total = 0 ; |
64 | |
adfe19db |
65 | # prime the pump, so the first "make realclean" will work. |
dbda3434 |
66 | runit("perl Makefile.PL") || die "Cannot run perl Makefile.PL\n" ; |
67 | |
68 | foreach my $perl (@GoodPerls) |
0a7c7f4f |
69 | { |
adfe19db |
70 | my $prefix = $verbose ? "$perl -- " : ''; |
0a7c7f4f |
71 | print "Testing $perl " . ('.' x ($maxlen - length $perl)) ; |
dbda3434 |
72 | |
adfe19db |
73 | my $ok = runit("$MAKE realclean") && |
dbda3434 |
74 | runit("$perl Makefile.PL") && |
adfe19db |
75 | # runit("$perl Makefile.PL --with-apicheck") && |
76 | runit("$MAKE test"); |
0a7c7f4f |
77 | |
78 | ++ $total; |
79 | if ($ok) { |
80 | ++ $good ; |
dbda3434 |
81 | print "${prefix}ok\n"; |
0a7c7f4f |
82 | } |
83 | else { |
84 | ++ $bad ; |
dbda3434 |
85 | print "${prefix}not ok\n" ; |
0a7c7f4f |
86 | } |
87 | |
88 | } |
89 | |
44284200 |
90 | print "\n\nPassed with $good of $total versions of Perl.\n\n"; |
0a7c7f4f |
91 | exit $bad ; |
92 | |
93 | |
94 | sub runit |
95 | { |
dbda3434 |
96 | # TODO -- portability alert!! |
97 | |
0a7c7f4f |
98 | my $cmd = shift ; |
dbda3434 |
99 | print "\n Running [$cmd]\n" if $verbose ; |
dbda3434 |
100 | my $output = `$cmd 2>&1` ; |
44284200 |
101 | $output = "\n" unless defined $output; |
dbda3434 |
102 | $output =~ s/^/ /gm; |
44284200 |
103 | print "\n Output\n$output\n" if $verbose || $? ; |
0a7c7f4f |
104 | if ($?) |
105 | { |
44284200 |
106 | warn " Running '$cmd' failed: $?\n" ; |
107 | return 0 ; |
0a7c7f4f |
108 | } |
0a7c7f4f |
109 | return 1 ; |
110 | } |
44284200 |
111 | |
112 | sub Usage |
113 | { |
114 | die <<EOM; |
115 | |
116 | usage: soak [OPT] [perl...] |
117 | |
118 | OPT |
119 | -m make - the name of the make program. Default "make" |
120 | -v - verbose |
121 | |
122 | EOM |
123 | |
124 | } |
125 | |
126 | sub FindPerls |
127 | { |
128 | # TODO -- need to decide how far back we go. |
129 | # TODO -- get list of user releases prior to 5.004 |
130 | |
131 | # find all version of Perl that are available |
132 | my @PerlBinaries = qw( |
133 | 5.000 |
134 | 5.001 |
135 | 5.002 |
136 | 5.003 |
137 | 5.004 |
138 | 5.00401 |
139 | 5.00402 |
140 | 5.00403 |
141 | 5.00404 |
142 | 5.00405 |
143 | 5.005 |
144 | 5.00501 |
145 | 5.00502 |
146 | 5.00503 |
147 | 5.6.0 |
148 | 5.6.1 |
149 | 5.7.0 |
150 | 5.7.1 |
151 | 5.7.2 |
152 | ); |
153 | |
154 | print "Searching for Perl binaries...\n" ; |
155 | my @GoodPerls = (); |
156 | my $maxlen = 0; |
157 | my $mm = MM->new( { NAME => 'dummy' }); |
158 | my @path = $mm->path(); |
159 | |
160 | # find_perl will send a warning to STDOUT if it can't find |
161 | # the requested perl, so need to temporarily silence STDOUT. |
162 | tie(*STDOUT, 'NoSTDOUT'); |
163 | |
164 | foreach my $perl (@PerlBinaries) { |
165 | if (my $abs = $mm->find_perl($perl, ["perl$perl"], [@path], 0)) { |
166 | push @GoodPerls, $abs ; |
167 | } |
168 | } |
169 | untie *STDOUT; |
170 | |
171 | print "\n\nFound\n"; |
172 | foreach (@GoodPerls) { print " $_\n" } |
173 | print "\n\n"; |
174 | |
175 | return @GoodPerls; |
176 | } |
177 | |
178 | package NoSTDOUT; |
179 | |
180 | use Tie::Handle; |
181 | our @ISA = qw(Tie::Handle); |
182 | |
183 | sub TIEHANDLE |
184 | { |
185 | my ($class) = @_; |
186 | my $buf = ""; |
187 | bless \$buf, $class; |
188 | } |
189 | |
190 | sub PRINT |
191 | { |
192 | my $self = shift; |
193 | } |
194 | |
195 | sub WRITE |
196 | { |
197 | my $self = shift; |
198 | } |
adfe19db |
199 | |
200 | |