Commit | Line | Data |
a5f75d66 |
1 | #!./perl |
2 | |
3 | # We suppose that perl _mostly_ works at this moment, so may use |
4 | # sophisticated testing. |
5 | |
aa689395 |
6 | BEGIN { |
7 | chdir 't' if -d 't'; |
122a0375 |
8 | @INC = '../lib'; # pick up only this build's lib |
ef712cf7 |
9 | $ENV{PERL5LIB} = '../lib'; # so children will see it too |
aa689395 |
10 | } |
aa689395 |
11 | |
e018f8be |
12 | my $torture; # torture testing? |
13 | |
a5f75d66 |
14 | use Test::Harness; |
9a4933c3 |
15 | use strict; |
a5f75d66 |
16 | |
ef712cf7 |
17 | $Test::Harness::switches = ""; # Too much noise otherwise |
9d6c4c89 |
18 | $Test::Harness::Verbose++ while @ARGV && $ARGV[0] eq '-v' && shift; |
a5f75d66 |
19 | |
12558422 |
20 | if ($ARGV[0] && $ARGV[0] eq '-torture') { |
e018f8be |
21 | shift; |
22 | $torture = 1; |
23 | } |
24 | |
60e23f2f |
25 | # Let tests know they're running in the perl core. Useful for modules |
26 | # which live dual lives on CPAN. |
27 | $ENV{PERL_CORE} = 1; |
28 | |
0ca04487 |
29 | #fudge DATA for now. |
9a4933c3 |
30 | my %datahandle = qw( |
0ca04487 |
31 | lib/bigint.t 1 |
32 | lib/bigintpm.t 1 |
33 | lib/bigfloat.t 1 |
34 | lib/bigfloatpm.t 1 |
35 | op/gv.t 1 |
36 | lib/complex.t 1 |
37 | lib/ph.t 1 |
38 | lib/soundex.t 1 |
39 | op/misc.t 1 |
40 | op/runlevel.t 1 |
41 | op/tie.t 1 |
42 | op/lex_assign.t 1 |
0ca04487 |
43 | ); |
44 | |
45 | foreach (keys %datahandle) { |
46 | unlink "$_.t"; |
47 | } |
48 | |
9ae5a6c3 |
49 | my (@tests, $rules, $re); |
122a0375 |
50 | |
40996b78 |
51 | # [.VMS]TEST.COM calls harness with empty arguments, so clean-up @ARGV |
52 | @ARGV = grep $_ && length( $_ ) => @ARGV; |
53 | |
6234cb77 |
54 | sub _populate_hash { |
55 | return map {$_, 1} split /\s+/, $_[0]; |
56 | } |
57 | |
9ae5a6c3 |
58 | sub _glob_and_parallelise { |
59 | my @dirs; |
60 | # Run the tests in each of these directories in sequence, but the |
61 | # directories themselves can be parallelised. |
62 | foreach (@_) { |
63 | push @dirs, { seq => [ glob "$_/*.t" ] }; |
64 | } |
65 | { par => \@dirs }; |
66 | } |
67 | |
68 | # Generate T::H schedule rules that run the contents of each directory |
69 | # sequentially. |
70 | sub _seq_dir_rules { |
71 | my @tests = @_; |
72 | my %dir; |
73 | for (@tests) { |
74 | s{[^/]+$}{\*}; |
75 | $dir{$_}++; |
76 | } |
77 | |
78 | return { par => [ map { { seq => $_ } } sort keys %dir ] }; |
79 | } |
80 | |
81 | sub _extract_tests; |
82 | sub _extract_tests { |
83 | # This can probably be done more tersely with a map, but I doubt that it |
84 | # would be as clear |
85 | my @results; |
86 | foreach (@_) { |
87 | my $ref = ref $_; |
88 | if ($ref) { |
89 | if ($ref eq 'ARRAY') { |
90 | push @results, _extract_tests @$_; |
91 | } elsif ($ref eq 'HASH') { |
92 | push @results, _extract_tests values %$_; |
93 | } else { |
94 | die "Unknown reference type $ref"; |
95 | } |
96 | } else { |
97 | push @results, $_; |
98 | } |
99 | } |
100 | @results; |
101 | } |
102 | |
12558422 |
103 | if ($ARGV[0] && $ARGV[0]=~/^-re/) { |
8a76aa1f |
104 | if ($ARGV[0]!~/=/) { |
105 | shift; |
106 | $re=join "|",@ARGV; |
107 | @ARGV=(); |
108 | } else { |
109 | (undef,$re)=split/=/,shift; |
110 | } |
111 | } |
112 | |
7a315204 |
113 | if (@ARGV) { |
4efb34a6 |
114 | if ($^O eq 'MSWin32') { |
115 | @tests = map(glob($_),@ARGV); |
116 | } |
117 | else { |
118 | @tests = @ARGV; |
119 | } |
7a315204 |
120 | } else { |
9ae5a6c3 |
121 | # Ideally we'd get somewhere close to Tux's Oslo rules |
122 | # my $rules = { |
123 | # par => [ |
124 | # { seq => '../ext/DB_File/t/*' }, |
125 | # { seq => '../ext/IO_Compress_Zlib/t/*' }, |
126 | # { seq => '../lib/CPANPLUS/*' }, |
127 | # { seq => '../lib/ExtUtils/t/*' }, |
128 | # '*' |
129 | # ] |
130 | # }; |
131 | |
132 | # but for now, run all directories in sequence. In particular, it would be |
133 | # nice to get the tests in t/op/*.t able to run in parallel. |
134 | |
b695f709 |
135 | unless (@tests) { |
9ae5a6c3 |
136 | my @seq; |
137 | push @seq, <base/*.t>; |
138 | |
139 | push @seq, _glob_and_parallelise qw(comp cmd run io); |
e6867818 |
140 | my @next = qw(uni mro lib); |
9ae5a6c3 |
141 | push @next, 'japh' if $torture; |
142 | push @next, 'win32' if $^O eq 'MSWin32'; |
e6867818 |
143 | push @seq, { par => [ |
144 | {seq => [ glob "op/*.t" ]}, |
145 | map { glob "$_/*.t" } @next |
146 | ] }; |
9ae5a6c3 |
147 | |
148 | my @last; |
6234cb77 |
149 | use Config; |
150 | my %skip; |
151 | { |
152 | my %extensions = _populate_hash $Config{'extensions'}; |
153 | my %known_extensions = _populate_hash $Config{'known_extensions'}; |
154 | foreach (keys %known_extensions) { |
155 | $skip{$_}++ unless $extensions{$_}; |
156 | } |
157 | } |
b695f709 |
158 | use File::Spec; |
159 | my $updir = File::Spec->updir; |
122a0375 |
160 | my $mani = File::Spec->catfile(File::Spec->updir, "MANIFEST"); |
b695f709 |
161 | if (open(MANI, $mani)) { |
b1d1c89d |
162 | my @manitests = (); |
00701878 |
163 | my $ext_pat = $^O eq 'MSWin32' ? '(?:win32/)?ext' : 'ext'; |
b695f709 |
164 | while (<MANI>) { # similar code in t/TEST |
00701878 |
165 | if (m!^($ext_pat/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) { |
6234cb77 |
166 | my ($test, $extension) = ($1, $2); |
167 | if (defined $extension) { |
168 | $extension =~ s!/t$!!; |
169 | # XXX Do I want to warn that I'm skipping these? |
170 | next if $skip{$extension}; |
171 | } |
b1d1c89d |
172 | push @manitests, File::Spec->catfile($updir, $test); |
b695f709 |
173 | } |
7a315204 |
174 | } |
35d88760 |
175 | close MANI; |
b1d1c89d |
176 | # Sort the list of test files read from MANIFEST into a sensible |
177 | # order instead of using the order in which they are listed there |
9ae5a6c3 |
178 | push @last, sort { lc $a cmp lc $b } @manitests; |
b695f709 |
179 | } else { |
180 | warn "$0: cannot open $mani: $!\n"; |
7a315204 |
181 | } |
9ae5a6c3 |
182 | push @last, <Module_Pluggable/*.t>; |
183 | push @last, <pod/*.t>; |
184 | push @last, <x2p/*.t>; |
185 | |
186 | @tests = (_extract_tests (@seq), @last); |
187 | |
188 | push @seq, _seq_dir_rules @last; |
189 | |
190 | $rules = { seq => \@seq }; |
191 | |
7a315204 |
192 | } |
193 | } |
22a65f1e |
194 | if ($^O eq 'MSWin32') { |
195 | s,\\,/,g for @tests; |
196 | } |
8a76aa1f |
197 | @tests=grep /$re/, @tests |
198 | if $re; |
9ae5a6c3 |
199 | |
200 | my $jobs = $ENV{TEST_JOBS}; |
201 | if ($jobs) { |
202 | eval 'use TAP::Harness 3.13; 1' or die $@; |
203 | my $h = TAP::Harness->new({ jobs => $jobs, rules => $rules}); |
204 | $h->runtests(@tests); |
205 | } else { |
206 | Test::Harness::runtests @tests; |
207 | } |
de125441 |
208 | exit(0); |